init/0000755000000000000000000000000012737600511010521 5ustar rootrootinit/new.sh0000644000000000000000000000006012730463074011646 0ustar rootroot#!/bin/bash cd /tmp tar zxvf /tmp/init.tar.gz init/procmon.sh0000755000000000000000000000216112362152000012522 0ustar rootroot#!/bin/sh confile=$1 MAIL='/usr/bin/mail' OS=`uname` if [ "${OS}" = "FreeBSD" ]; then ps="ps -ax -w" sed="sed -E" else ps="ps -e -o pid,state,command" sed="sed -r" fi SNfile=`ls / |grep -E "SN[0-9]{8}"` ip=`sed -n '2p' /$SNfile|awk -F'[:+ ]' '{print $3}'` procmon () { _PNAME=$1 _PDD=$2 _PCOM=$3 if [ "${_PNAME}" = "pid" ]; then procname=`echo ${_PDD} | $sed 's/(.*\/|\.pid)//g'` if [ -r ${_PDD} ]; then pid=`cat ${_PDD}` ps $pid 2>&1 > /dev/null if [ $? -ne 0 ]; then procid= else procid=$pid fi else procid= fi else procname=${_PNAME} if [ "${_PDD}" = "no" ]; then procid=`$ps | grep ${_PNAME} | grep -v grep | awk '{print $1}'` else procid=`$ps | grep ${_PNAME} | grep ${_PDD} | \ grep -v grep | awk '{print $1}'` fi fi #echo $procname #echo "${_PNAME}:${_PDD}" #echo "procid:$procid" if [ -z "$procid" ]; then ${_PCOM} start > /tmp/procmon.tmp 2>&1 printf "`date`\n`cat /tmp/procmon.tmp`\n$procname is restart" >> /tmp/procmon.log fi } while read LINE; do proc=`echo ${LINE} | cut -f 1 -d '#'` if [ -n "${proc}" ]; then procmon $proc fi done < ${confile} init/sysctl.conf0000644000000000000000000000333412362154632012716 0ustar rootroot# Kernel sysctl configuration file for Red Hat Linux # # For binary values, 0 is disabled, 1 is enabled. See sysctl(8) and # sysctl.conf(5) for more details. # Controls IP packet forwarding net.ipv4.ip_forward = 0 # Controls source route verification net.ipv4.conf.default.rp_filter = 1 # Do not accept source routing net.ipv4.conf.default.accept_source_route = 0 # Controls the System Request debugging functionality of the kernel kernel.sysrq = 0 # Controls whether core dumps will append the PID to the core filename. # Useful for debugging multi-threaded applications. kernel.core_uses_pid = 1 # Controls the use of TCP syncookies net.ipv4.tcp_syncookies = 1 # Disable netfilter on bridges. net.bridge.bridge-nf-call-ip6tables = 0 net.bridge.bridge-nf-call-iptables = 0 net.bridge.bridge-nf-call-arptables = 0 # Controls the default maxmimum size of a mesage queue kernel.msgmnb = 65536 # Controls the maximum size of a message, in bytes kernel.msgmax = 65536 # Controls the maximum shared segment size, in bytes kernel.shmmax = 68719476736 # Controls the maximum number of shared memory segments, in pages kernel.shmall = 4294967296 net.core.rmem_max = 16777216 net.core.wmem_max = 16777216 net.ipv4.tcp_mem = 129940 129940 33554432 net.ipv4.tcp_rmem = 28800 129940 16777216 net.ipv4.tcp_wmem = 28800 129940 16777216 fs.file-max = 1604720 net.core.somaxconn = 4096 net.ipv4.conf.all.send_redirects = 0 net.ipv4.conf.all.accept_redirects = 0 net.ipv4.conf.all.secure_redirects = 0 net.ipv4.tcp_tw_reuse = 1 net.ipv4.tcp_tw_recycle = 1 net.ipv4.tcp_max_tw_buckets = 180000 net.ipv4.tcp_syn_retries = 3 net.ipv4.tcp_synack_retries = 3 net.nf_conntrack_max = 6553600 net.ipv4.tcp_max_syn_backlog = 809200 net.core.netdev_max_backlog = 809200 init/snmpmon/0000755000000000000000000000000012743550370012214 5ustar rootrootinit/snmpmon/Net-SNMP-v6.0.1.tar0000644000000000000000000163000012421635662015054 0ustar rootrootNet-SNMP-v6.0.1/0000755000175000017500000000000011442272645012264 5ustar dtowndtownNet-SNMP-v6.0.1/Build.PL0000444000175000017500000000352711442272645013565 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: Build.PL,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Build.PL file for the Perl module Net::SNMP. # Copyright (c) 2008-2009 David M. Town # 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 Module::Build; Module::Build->new( module_name => 'Net::SNMP', dist_author => 'David M. Town ', dist_abstract => 'Object oriented interface to SNMP', dist_version_from => 'lib/Net/SNMP.pm', license => 'perl', script_files => [ 'snmpkey', ], PL_files => { 'snmpkey.PL' => 'snmpkey', }, build_requires => { Test => 0, }, requires => { perl => '5.006', Carp => 0, Errno => 0, Exporter => 0, IO::Socket => 0, Math::BigInt => 0, }, recommends => { Crypt::DES => '2.03', # SNMPv3 Digest::MD5 => '2.11', # SNMPv3 Digest::SHA1 => '1.02', # SNMPv3 Digest::HMAC => '1.00', # SNMPv3 Crypt::Rijndael => '1.02', # SNMPv3 - AES Cipher Algorithm Socket6 => '0.23', # UDP/IPv6 or TCP/IPv6 Transport Domain }, meta_merge => { resources => { bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SNMP', CPANForum => 'http://www.cpanforum.com/dist/Net-SNMP', }, }, create_license => 1, )->create_build_script(); exit 0; # ============================================================================ Net-SNMP-v6.0.1/MANIFEST0000444000175000017500000000140211442272645013410 0ustar dtowndtownBuild.PL Changes examples/example1.pl examples/example2.pl examples/example3.pl examples/example4.pl examples/snmpget.pl examples/snmpgetbulk.pl examples/snmpgetnext.pl examples/snmpset.pl examples/snmpwalk.pl examples/table.pl examples/trap.pl lib/Net/SNMP.pm lib/Net/SNMP/Dispatcher.pm lib/Net/SNMP/Message.pm lib/Net/SNMP/MessageProcessing.pm lib/Net/SNMP/PDU.pm lib/Net/SNMP/Security.pm lib/Net/SNMP/Security/Community.pm lib/Net/SNMP/Security/USM.pm lib/Net/SNMP/Transport.pm lib/Net/SNMP/Transport/IPv4.pm lib/Net/SNMP/Transport/IPv6.pm lib/Net/SNMP/Transport/IPv4/TCP.pm lib/Net/SNMP/Transport/IPv4/UDP.pm lib/Net/SNMP/Transport/IPv6/TCP.pm lib/Net/SNMP/Transport/IPv6/UDP.pm LICENSE Makefile.PL MANIFEST META.yml README snmpkey.PL t/ber.t t/dsp.t t/mp.t t/usm.t Net-SNMP-v6.0.1/snmpkey.PL0000444000175000017500000001276311442272645014216 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpkey.PL,v 6.0 2009/09/09 15:07:48 dtown Rel $ # Copyright (c) 2001-2009 David M. Town # 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 warnings; use Config; my $file = shift || 'snmpkey'; my $fh; open($fh, q{>}, "$file") || die "Failed to open file '$file' [$!]"; print {$fh} "$Config{startperl}\n"; print {$fh} <<'AS-IS'; # ============================================================================ # $Id: snmpkey.PL,v 6.0 2009/09/09 15:07:48 dtown Rel $ # Copyright (c) 2001-2009 David M. Town # 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. # ============================================================================ =head1 NAME snmpkey - Create SNMPv3 security keys for the Net::SNMP module =head1 USAGE The C utility generates security keys based on a password and an authoritativeEngineID passed on the command line. This key can then be used by the Net::SNMP module instead of the plain text password when creating SNMPv3 objects. snmpkey [ []] =head1 DESCRIPTION The User-based Security Model used by SNMPv3 defines an algorithm which "localizes" a plain text password to a specific authoritativeEngineID using a one-way hash. This resulting key is used by the SNMP application instead of the plain text password for security reasons. The Net::SNMP module allows the user to either provide a plain text password or a localized key to the object constructor when configuring authentication or privacy. The C utility can be used to generate the key to be used by the B<-authkey> or B<-privkey> named arguments when they are passed to the Net::SNMP C constructor. =head1 REQUIRED ARGUMENTS The C utility requires at least three command line arguments. The first argument defines which hash algorithm to use when creating the authKey. Either HMAC-MD5-96 or HMAC-SHA-96 can be specified with the string 'md5' or 'sha' respectively. This choice must match the algorithm passed to the B<-authprotocol> argument when creating the Net::SNMP object. The second argument is the plain text password that is to be localized to create the authKey. The third required argument is the authoritativeEngineID of the remote SNMP engine associated with the Net::SNMP argument B<-hostname>. The authoritativeEngineID is to be entered as a hexadecimal string 10 to 64 characters (5 to 32 octets) long and can be prefixed with an optional "0x". The last two arguments are optional and can be used to determine how the privKey will be generated. By default, the fourth argument assumes a value of 'des' corresponding to the default privacy protocol defined in the User-based Security Model. The Net::SNMP module supports CBC-3DES-EDE and CFB128-AES-128 as alternatives to the default protocol CBC-DES. These protocols can be chosen by specifying the string '3des' or 'aes' respectively. This choice must match the protocol passed to the B<-privprotocol> argument when creating the Net::SNMP object. The last argument can be used to specify the plain text password that is to be localized to create the privKey. If this argument is not specified, the authKey password is used. =head1 AUTHOR David M. Town =head1 LICENSE AND COPYRIGHT Copyright (c) 2001-2009 David M. Town. 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. =head1 SEE ALSO L =cut # ============================================================================ use strict; use warnings; use Net::SNMP::Security::USM 4.0; our $SCRIPT = 'snmpkey'; our $VERSION = v6.0.0; # Do we have enough/too much information? if ((@ARGV < 3) || (@ARGV > 5)) { usage(); } my ($usm, $error) = Net::SNMP::Security::USM->new( -authoritative => 1, # Undocumented / unsupported argument -username => 'initial', -authprotocol => $ARGV[0], -authpassword => $ARGV[1], -engineid => $ARGV[2], -privprotocol => (@ARGV > 3) ? $ARGV[3] : 'des', -privpassword => (@ARGV > 4) ? $ARGV[4] : $ARGV[1] ); if (!defined $usm) { abort($error); } printf "authKey: 0x%s\n", unpack 'H*', $usm->auth_key(); printf "privKey: 0x%s\n", unpack 'H*', $usm->priv_key(); exit 0; # [functions] ---------------------------------------------------------------- sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { printf "%s v%vd\n", $SCRIPT, $VERSION; print << "USAGE"; Copyright (c) 2001-2009 David M. Town. All rights reserved. All rights reserved. Usage: $SCRIPT [ []] = md5|sha = des|3des|aes USAGE exit 1; } # ============================================================================ AS-IS close($fh) || die "Failed to close file '$file' [$!]"; chmod(0755, $file) || die "Failed to set permissions for file '$file' [$!]"; exit 0; # ============================================================================ Net-SNMP-v6.0.1/lib/0000755000175000017500000000000011442272645013032 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/0000755000175000017500000000000011442272645013560 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP.pm0000444000175000017500000034150511442272645014701 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ package Net::SNMP; # $Id: SNMP.pm,v 6.1 2010/09/10 00:01:22 dtown Rel $ # Copyright (c) 1998-2010 David M. Town # 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. # Release 4.0.0 of the Net::SNMP module was dedicated to those who died in # the September 11, 2001 terrorist attacks on the United States of America. # ============================================================================ =head1 NAME Net::SNMP - Object oriented interface to SNMP =head1 SYNOPSIS The Net::SNMP module implements an object oriented interface to the Simple Network Management Protocol. Perl applications can use the module to retrieve or update information on a remote host using the SNMP protocol. The module supports SNMP version-1, SNMP version-2c (Community-Based SNMPv2), and SNMP version-3. The Net::SNMP module assumes that the user has a basic understanding of the Simple Network Management Protocol and related network management concepts. =head1 DESCRIPTION The Net::SNMP module abstracts the intricate details of the Simple Network Management Protocol by providing a high level programming interface to the protocol. Each Net::SNMP object provides a one-to-one mapping between a Perl object and a remote SNMP agent or manager. Once an object is created, it can be used to perform the basic protocol exchange actions defined by SNMP. A Net::SNMP object can be created such that it has either "blocking" or "non-blocking" properties. By default, the methods used to send SNMP messages do not return until the protocol exchange has completed successfully or a timeout period has expired. This behavior gives the object a "blocking" property because the flow of the code is stopped until the method returns. The optional named argument B<-nonblocking> can be passed to the object constructor with a true value to give the object "non-blocking" behavior. A method invoked by a non-blocking object queues the SNMP message and returns immediately, allowing the flow of the code to continue. The queued SNMP messages are not sent until an event loop is entered by calling the C method. When the SNMP messages are sent, any response to the messages invokes the subroutine defined by the user when the message was originally queued. The event loop exits when all messages have been removed from the queue by either receiving a response, or by exceeding the number of retries at the Transport Layer. =head2 Blocking Objects The default behavior of the methods associated with a Net::SNMP object is to block the code flow until the method completes. For methods that initiate a SNMP protocol exchange requiring a response, a hash reference containing the results of the query is returned. The undefined value is returned by all methods when a failure has occurred. The C method can be used to determine the cause of the failure. The hash reference returned by a SNMP protocol exchange points to a hash constructed from the VarBindList contained in the SNMP response message. The hash is created using the ObjectName and the ObjectSyntax pairs in the VarBindList. The keys of the hash consist of the OBJECT IDENTIFIERs in dotted notation corresponding to each ObjectName in the VarBindList. The value of each hash entry is set equal to the value of the corresponding ObjectSyntax. This hash reference can also be retrieved using the C method. =head2 Non-blocking Objects When a Net::SNMP object is created having non-blocking behavior, the invocation of a method associated with the object returns immediately, allowing the flow of the code to continue. When a method is invoked that would initiate a SNMP protocol exchange requiring a response, either a true value (i.e. 0x1) is returned immediately or the undefined value is returned if there was a failure. The C method can be used to determine the cause of the failure. The contents of the VarBindList contained in the SNMP response message can be retrieved by calling the C method using the object reference passed as the first argument to the callback. The value returned by the C method is a hash reference created using the ObjectName and the ObjectSyntax pairs in the VarBindList. The keys of the hash consist of the OBJECT IDENTIFIERs in dotted notation corresponding to each ObjectName in the VarBindList. The value of each hash entry is set equal to the value of the corresponding ObjectSyntax. The undefined value is returned if there has been a failure and the C method may be used to determine the reason. =cut # ============================================================================ use strict; ## Validate the version of Perl BEGIN { die 'Perl version 5.6.0 or greater is required' if ($] < 5.006); } ## Version of the Net::SNMP module our $VERSION = 'v6.0.1'; $VERSION = eval $VERSION; ## Load our modules use Net::SNMP::Dispatcher(); use Net::SNMP::PDU qw( :ALL !DEBUG_INFO ); use Net::SNMP::Security(); use Net::SNMP::Transport qw( :ports ); ## Handle importing/exporting of symbols use base qw( Exporter ); our @EXPORT = qw( INTEGER INTEGER32 OCTET_STRING OBJECT_IDENTIFIER IPADDRESS COUNTER COUNTER32 GAUGE GAUGE32 UNSIGNED32 TIMETICKS OPAQUE COUNTER64 NOSUCHOBJECT NOSUCHINSTANCE ENDOFMIBVIEW snmp_dispatcher ); our @EXPORT_OK = qw( oid_context_match ); our %EXPORT_TAGS = ( asn1 => [ 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 ) ], debug => [ qw( DEBUG_ALL DEBUG_NONE DEBUG_MESSAGE DEBUG_TRANSPORT DEBUG_DISPATCHER DEBUG_PROCESSING DEBUG_SECURITY snmp_debug ) ], generictrap => [ qw( COLD_START WARM_START LINK_DOWN LINK_UP AUTHENTICATION_FAILURE EGP_NEIGHBOR_LOSS ENTERPRISE_SPECIFIC ) ], snmp => [ qw( SNMP_VERSION_1 SNMP_VERSION_2C SNMP_VERSION_3 SNMP_PORT SNMP_TRAP_PORT snmp_debug snmp_dispatcher snmp_dispatch_once snmp_type_ntop oid_base_match oid_lex_cmp oid_lex_sort ticks_to_time ) ], translate => [ qw( TRANSLATE_NONE TRANSLATE_OCTET_STRING TRANSLATE_NULL TRANSLATE_TIMETICKS TRANSLATE_OPAQUE TRANSLATE_NOSUCHOBJECT TRANSLATE_NOSUCHINSTANCE TRANSLATE_ENDOFMIBVIEW TRANSLATE_UNSIGNED TRANSLATE_ALL ) ], ); Exporter::export_ok_tags( qw( asn1 debug generictrap snmp translate ) ); $EXPORT_TAGS{ALL} = [ @EXPORT_OK ]; ## Debugging bit masks sub DEBUG_ALL { 0xff } # All sub DEBUG_NONE { 0x00 } # None sub DEBUG_MESSAGE { 0x02 } # Message/PDU encoding/decoding sub DEBUG_TRANSPORT { 0x04 } # Transport Layer sub DEBUG_DISPATCHER { 0x08 } # Dispatcher sub DEBUG_PROCESSING { 0x10 } # Message Processing sub DEBUG_SECURITY { 0x20 } # Security ## Package variables our $DEBUG = DEBUG_NONE; # Debug mask our $DISPATCHER; # Dispatcher instance our $BLOCKING = 0; # Count of blocking objects our $NONBLOCKING = 0; # Count of non-blocking objects BEGIN { # Validate the creation of the Dispatcher object. if (!defined ($DISPATCHER = Net::SNMP::Dispatcher->instance())) { die 'FATAL: Failed to create Dispatcher instance'; } # In older versions of Perl, the UNIVERSAL::VERSION() method does not # handle version defined as v-strings gracefully. We provide our # own handling of versions to account for this. if ($] < 5.009) { *VERSION = \&require_version; } } # [public methods] ----------------------------------------------------------- =head1 METHODS When named arguments are expected by the methods, two different styles are supported. All examples in this documentation use the dashed-option style: $object->method(-argument => $value); However, the IO:: style is also allowed: $object->method(Argument => $value); =over =item Non-blocking Objects Arguments When a Net::SNMP object has been created with a "non-blocking" property, most methods that generate a SNMP message take additional arguments to support this property. =over =item Callback Most methods associated with a non-blocking object have an optional named argument called B<-callback>. The B<-callback> argument expects a reference to a subroutine or to an array whose first element must be a reference to a subroutine. The subroutine defined by the B<-callback> option is executed when a response to a SNMP message is received, an error condition has occurred, or the number of retries for the message has been exceeded. When the B<-callback> argument only contains a subroutine reference, the subroutine is evaluated passing a reference to the original Net::SNMP object as the only parameter. If the B<-callback> argument was defined as an array reference, all elements in the array are passed to subroutine after the reference to the Net::SNMP object. The first element, which is required to be a reference to a subroutine, is removed before the remaining arguments are passed to that subroutine. Once one method is invoked with the B<-callback> argument, this argument stays with the object and is used by any further calls to methods using the B<-callback> option if the argument is absent. The undefined value may be passed to the B<-callback> argument to delete the callback. B The subroutine being passed with the B<-callback> named argument should not cause blocking itself. This will cause all the actions in the event loop to be stopped, defeating the non-blocking property of the Net::SNMP module. =item Delay An optional argument B<-delay> can also be passed to non-blocking objects. The B<-delay> argument instructs the object to wait the number of seconds passed to the argument before executing the SNMP protocol exchange. The delay period starts when the event loop is entered. The B<-delay> parameter is applied to all methods associated with the object once it is specified. The delay value must be set back to 0 seconds to disable the delay parameter. =back =item SNMPv3 Arguments A SNMP context is a collection of management information accessible by a SNMP entity. An item of management information may exist in more than one context and a SNMP entity potentially has access to many contexts. The combination of a contextEngineID and a contextName unambiguously identifies a context within an administrative domain. In a SNMPv3 message, the contextEngineID and contextName are included as part of the scopedPDU. All methods that generate a SNMP message optionally take a B<-contextengineid> and B<-contextname> argument to configure these fields. =over =item Context Engine ID The B<-contextengineid> argument expects a hexadecimal string representing the desired contextEngineID. The string must be 10 to 64 characters (5 to 32 octets) long and can be prefixed with an optional "0x". Once the B<-contextengineid> is specified it stays with the object until it is changed again or reset to default by passing in the undefined value. By default, the contextEngineID is set to match the authoritativeEngineID of the authoritative SNMP engine. =item Context Name The contextName is passed as a string which must be 0 to 32 octets in length using the B<-contextname> argument. The contextName stays with the object until it is changed. The contextName defaults to an empty string which represents the "default" context. =back =back =cut { my @trans_argv = qw( hostname (?:de?st|peer)?(?:addr|port) (?:src|sock|local)(?:addr|port) maxmsgsize mtu retries timeout domain listen ); sub new { my ($class, %argv) = @_; # Create a new data structure for the object my $this = bless { '_callback' => undef, # Callback '_context_engine_id' => undef, # contextEngineID '_context_name' => undef, # contextName '_delay' => 0, # Message delay '_hostname' => q{}, # Hostname '_discovery_queue' => [], # Pending message queue '_error' => undef, # Error message '_nonblocking' => FALSE, # [Non-]blocking flag '_pdu' => undef, # Message/PDU object '_security' => undef, # Security Model object '_translate' => TRANSLATE_ALL, # Translation mask '_transport' => undef, # Transport Domain object '_transport_argv' => [], # Transport object argv '_version' => SNMP_VERSION_1, # SNMP version }, $class; # Parse the passed arguments for (keys %argv) { if (/^-?debug$/i) { $this->debug(delete $argv{$_}); } elsif (/^-?nonblocking$/i) { $this->{_nonblocking} = (delete $argv{$_}) ? TRUE : FALSE; } elsif (/^-?translate$/i) { $this->translate(delete $argv{$_}); } elsif (/^-?version$/i) { $this->_version($argv{$_}); } else { # Pull out arguments associated with the Transport Domain. my $key = $_; for (@trans_argv) { if ($key =~ /^-?$_$/i) { push @{$this->{_transport_argv}}, $key, delete $argv{$key}; last; } } } if (defined $this->{_error}) { $this->_object_type_validate(); return wantarray ? (undef, $this->{_error}) : undef; } } # We must validate the object type to prevent blocking and # non-blocking object from existing at the same time. if (!defined $this->_object_type_validate()) { return wantarray ? (undef, $this->{_error}) : undef; } # Create a Security Model object ($this->{_security}, $this->{_error}) = Net::SNMP::Security->new(%argv); if (!defined $this->{_security}) { return wantarray ? (undef, $this->{_error}) : undef; } $this->_error_clear(); # Return the object and empty error message (in list context) return wantarray ? ($this, q{}) : $this; } } sub open { my ($this) = @_; # Clear any previous errors $this->_error_clear(); # Create a Transport Domain object ($this->{_transport}, $this->{_error}) = Net::SNMP::Transport->new( @{$this->{_transport_argv}} ); if (!defined $this->{_transport}) { return $this->_error(); } $this->_error_clear(); # Keep a copy of the hostname $this->{_hostname} = $this->{_transport}->dest_hostname(); # Perform SNMPv3 authoritative engine discovery. if ($this->version() == SNMP_VERSION_3) { $this->_perform_discovery(); } return defined($this->{_error}) ? $this->_error() : $this->{_transport}; } =head2 session() - create a new Net::SNMP object ($session, $error) = Net::SNMP->session( [-hostname => $hostname,] [-port => $port,] [-localaddr => $localaddr,] [-localport => $localport,] [-nonblocking => $boolean,] [-version => $version,] [-domain => $domain,] [-timeout => $seconds,] [-retries => $count,] [-maxmsgsize => $octets,] [-translate => $translate,] [-debug => $bitmask,] [-community => $community,] # v1/v2c [-username => $username,] # v3 [-authkey => $authkey,] # v3 [-authpassword => $authpasswd,] # v3 [-authprotocol => $authproto,] # v3 [-privkey => $privkey,] # v3 [-privpassword => $privpasswd,] # v3 [-privprotocol => $privproto,] # v3 ); This is the constructor for Net::SNMP objects. In scalar context, a reference to a new Net::SNMP object is returned if the creation of the object is successful. In list context, a reference to a new Net::SNMP object and an empty error message string is returned. If a failure occurs, the object reference is returned as the undefined value. The error string may be used to determine the cause of the error. Most of the named arguments passed to the constructor define basic attributes for the object and are not modifiable after the object has been created. The B<-timeout>, B<-retries>, B<-maxmsgsize>, B<-translate>, and B<-debug> arguments are modifiable using an accessor method. See their corresponding method definitions for a complete description of their usage, default values, and valid ranges. =over =item Transport Domain Arguments The Net::SNMP module uses UDP/IPv4 as the default Transport Domain to exchange SNMP messages between the local and remote devices. The module also supports UDP/IPv6, TCP/IPv4, and TCP/IPv6 as alternative Transport Domains. The B<-domain> argument can be used to change the Transport Domain by setting the value to one of the following strings: 'udp6', 'udp/ipv6'; 'tcp', 'tcp4', 'tcp/ipv4'; 'tcp6', or 'tcp/ipv6'. The B<-domain> argument also accepts the strings 'udp', 'udp4', or 'udp/ipv4' which correspond to the default Transport Domain of UDP/IPv4. The transport address of the destination SNMP device can be specified using the B<-hostname> argument. This argument is optional and defaults to "localhost". The destination port number can be specified as part of the transport address or by using the B<-port> argument. Either a numeric port number or a textual service name can be specified. A numeric port number in parentheses can optionally follow the service name. This port number will be used if the service name cannot be resolved. If the destination port number is not specified, the well-known SNMP port number 161 is used. By default the source transport address and port number are assigned dynamically by the local device on which the Net::SNMP module is being used. This dynamic assignment can be overridden by using the B<-localaddr> and B<-localport> arguments. These arguments accept the same values as the B<-hostname> and B<-port> arguments respectively. The resolved address must correspond to a valid address of an interface on the local device. When using an IPv4 Transport Domain, the transport address can be specified as either an IP network hostname or an IPv4 address in standard dotted notation. The port information can be optionally appended to the hostname or address delimited by a colon. The accepted IPv4 transport address formats are C
, C, C, and C. When using an IPv6 Transport Domain, the transport address can be specified as an IP hostname (which will be looked up as a DNS quad-A record) or an IPv6 address in presentation format. The port information can optionally be included following a colon after the hostname or address. When including this information after an IPv6 address, the address must be enclosed in square brackets. The scope zone index (described in RFC 4007) can be specified after the address as a decimal value delimited by a percent sign. The accepted transport address formats for IPv6 are C
, C, C<[address]:port>, C<[address%zone]:port>, C, and C. =item Security Model Arguments The B<-version> argument controls which other arguments are expected or required by the C constructor. The Net::SNMP module supports SNMPv1, SNMPv2c, and SNMPv3. The module defaults to SNMPv1 if no B<-version> argument is specified. The B<-version> argument expects either a digit (i.e. '1', '2', or '3') or a string specifying the version (i.e. 'snmpv1', 'snmpv2c', or 'snmpv3') to define the SNMP version. The Security Model used by the Net::SNMP object is based on the SNMP version associated with the object. If the SNMP version is SNMPv1 or SNMPv2c a Community-based Security Model will be used, while the User-based Security Model (USM) will be used if the version is SNMPv3. =over =item Community-based Security Model Argument If the Security Model is Community-based, the only argument available is the B<-community> argument. This argument expects a string that is to be used as the SNMP community name. By default the community name is set to 'public' if the argument is not present. =item User-based Security Model Arguments The User-based Security Model (USM) used by SNMPv3 requires that a securityName be specified using the B<-username> argument. The creation of a Net::SNMP object with the version set to SNMPv3 will fail if the B<-username> argument is not present. The B<-username> argument expects a string 1 to 32 octets in length. Different levels of security are allowed by the User-based Security Model which address authentication and privacy concerns. A SNMPv3 Net::SNMP object will derive the security level (securityLevel) based on which of the following arguments are specified. By default a securityLevel of 'noAuthNoPriv' is assumed. If the B<-authkey> or B<-authpassword> arguments are specified, the securityLevel becomes 'authNoPriv'. The B<-authpassword> argument expects a string which is at least 1 octet in length. Optionally, the B<-authkey> argument can be used so that a plain text password does not have to be specified in a script. The B<-authkey> argument expects a hexadecimal string produced by localizing the password with the authoritativeEngineID for the specific destination device. The C utility included with the distribution can be used to create the hexadecimal string (see L). Two different hash algorithms are defined by SNMPv3 which can be used by the Security Model for authentication. These algorithms are HMAC-MD5-96 "MD5" (RFC 1321) and HMAC-SHA-96 "SHA-1" (NIST FIPS PUB 180-1). The default algorithm used by the module is HMAC-MD5-96. This behavior can be changed by using the B<-authprotocol> argument. This argument expects either the string 'md5' or 'sha' to be passed to modify the hash algorithm. By specifying the arguments B<-privkey> or B<-privpassword> the securityLevel associated with the object becomes 'authPriv'. According to SNMPv3, privacy requires the use of authentication. Therefore, if either of these two arguments are present and the B<-authkey> or B<-authpassword> arguments are missing, the creation of the object fails. The B<-privkey> and B<-privpassword> arguments expect the same input as the B<-authkey> and B<-authpassword> arguments respectively. The User-based Security Model described in RFC 3414 defines a single encryption protocol to be used for privacy. This protocol, CBC-DES "DES" (NIST FIPS PUB 46-1), is used by default or if the string 'des' is passed to the B<-privprotocol> argument. The module also supports RFC 3826 which describes the use of CFB128-AES-128 "AES" (NIST FIPS PUB 197) in the USM. The AES encryption protocol can be selected by passing 'aes' or 'aes128' to the B<-privprotocol> argument. By working with the Extended Security Options Consortium L, the module also supports CBC-3DES-EDE "Triple-DES" (NIST FIPS 46-3) in the User-based Security Model. This is defined in the draft L. The Triple-DES encryption protocol can be selected using the B<-privprotocol> argument with the string '3des' or '3desede'. =back =back =cut sub session { my $class = shift; my ($this, $error) = $class->new(@_); if (defined $this) { if (!defined $this->open()) { return wantarray ? (undef, $this->error()) : undef; } } return wantarray ? ($this, $error) : $this; } sub manager { goto &session; } =head2 close() - clear the Transport Domain associated with the object $session->close(); This method clears the Transport Domain and any errors associated with the object. Once closed, the Net::SNMP object can no longer be used to send or receive SNMP messages. =cut sub close { my ($this) = @_; $this->_error_clear(); $this->{_pdu} = undef; $this->{_transport} = undef; return; } =head2 snmp_dispatcher() - enter the non-blocking object event loop $session->snmp_dispatcher(); This method enters the event loop associated with non-blocking Net::SNMP objects. The method exits when all queued SNMP messages have received a response or have timed out at the Transport Layer. This method is also exported as the stand alone function C by default (see L<"EXPORTS">). =cut sub snmp_dispatcher { return $DISPATCHER->loop(); } sub snmp_event_loop { require Carp; Carp::croak('snmp_event_loop() is obsolete, use snmp_dispatcher() instead'); goto &snmp_dispatcher; } sub snmp_dispatch_once { return $DISPATCHER->one_event(); } =head2 get_request() - send a SNMP get-request to the remote agent $result = $session->get_request( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -varbindlist => \@oids, ); This method performs a SNMP get-request query to gather data from the remote agent on the host associated with the Net::SNMP object. The message is built using the list of OBJECT IDENTIFIERs in dotted notation passed to the method as an array reference using the B<-varbindlist> argument. Each OBJECT IDENTIFIER is placed into a single SNMP GetRequest-PDU in the same order that it held in the original list. A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. =cut sub get_request { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_get_request(@argv)) { return $this->_error($this->{_pdu}->error()); } return $this->_send_pdu(); } =head2 get_next_request() - send a SNMP get-next-request to the remote agent $result = $session->get_next_request( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -varbindlist => \@oids, ); This method performs a SNMP get-next-request query to gather data from the remote agent on the host associated with the Net::SNMP object. The message is built using the list of OBJECT IDENTIFIERs in dotted notation passed to the method as an array reference using the B<-varbindlist> argument. Each OBJECT IDENTIFER is placed into a single SNMP GetNextRequest-PDU in the same order that it held in the original list. A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. =cut sub get_next_request { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_get_next_request(@argv)) { return $this->_error($this->{_pdu}->error()); } return $this->_send_pdu(); } =head2 set_request() - send a SNMP set-request to the remote agent $result = $session->set_request( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -varbindlist => \@oid_value, ); This method is used to modify data on the remote agent that is associated with the Net::SNMP object using a SNMP set-request. The message is built using a list of values consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value to be set. This list is passed to the method as an array reference using the B<-varbindlist> argument. The OBJECT IDENTIFIERs in each trio are to be in dotted notation. The object type is an octet corresponding to the ASN.1 type of value that is to be set. Each of the supported ASN.1 types have been defined and are exported by the package by default (see L<"EXPORTS">). A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. =cut sub set_request { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_set_request(@argv)) { return $this->_error($this->{_pdu}->error()); } return $this->_send_pdu(); } =head2 trap() - send a SNMP trap to the remote manager $result = $session->trap( [-delay => $seconds,] # non-blocking [-enterprise => $oid,] [-agentaddr => $ipaddress,] [-generictrap => $generic,] [-specifictrap => $specific,] [-timestamp => $timeticks,] -varbindlist => \@oid_value, ); This method sends a SNMP trap to the remote manager associated with the Net::SNMP object. All arguments are optional and will be given the following defaults in the absence of a corresponding named argument: =over =item * The default value for the trap B<-enterprise> is "1.3.6.1.4.1", which corresponds to "iso.org.dod.internet.private.enterprises". The enterprise value is expected to be an OBJECT IDENTIFER in dotted notation. =item * When the Transport Domain is UDP/IPv4 or TCP/IPv4, the default value for the trap B<-agentaddr> is the IP address associated with the interface on which the trap will be transmitted. For other Transport Domains the B<-agentaddr> is defaulted to "0.0.0.0". When specified, the agent-addr is expected to be an IpAddress in dotted notation. =item * The default value for the B<-generictrap> type is 6 which corresponds to "enterpriseSpecific". The generic-trap types are defined and can be exported upon request (see L<"EXPORTS">). =item * The default value for the B<-specifictrap> type is 0. No pre-defined values are available for specific-trap types. =item * The default value for the trap B<-timestamp> is the "uptime" of the script. The "uptime" of the script is the number of hundredths of seconds that have elapsed since the script began running. The time-stamp is expected to be a TimeTicks number in hundredths of seconds. =item * The default value for the trap B<-varbindlist> is an empty array reference. The variable-bindings are expected to be in an array format consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value of the object. This is identical to the list expected by the C method. The OBJECT IDENTIFIERs in each trio are to be in dotted notation. The object type is an octet corresponding to the ASN.1 type for the value. Each of the supported types have been defined and are exported by default (see L<"EXPORTS">). =back A true value is returned when the method is successful. The undefined value is returned when a failure has occurred. The C method can be used to determine the cause of the failure. Since there are no acknowledgements for Trap-PDUs, there is no way to determine if the remote host actually received the trap. B When the object is in non-blocking mode, the trap is not sent until the event loop is entered and no callback is ever executed. B This method can only be used when the version of the object is set to SNMPv1. =cut sub trap { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -delay -enterprise -agentaddr -generictrap -specifictrap -timestamp -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_trap(@argv)) { return $this->_error($this->{_pdu}->error()); } $this->_send_pdu(); return defined($this->{_error}) ? $this->_error() : TRUE; } =head2 get_bulk_request() - send a SNMP get-bulk-request to the remote agent $result = $session->get_bulk_request( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 [-nonrepeaters => $non_reps,] [-maxrepetitions => $max_reps,] -varbindlist => \@oids, ); This method performs a SNMP get-bulk-request query to gather data from the remote agent on the host associated with the Net::SNMP object. All arguments are optional except B<-varbindlist> and will be given the following defaults in the absence of a corresponding named argument: =over =item * The default value for the get-bulk-request B<-nonrepeaters> is 0. The non-repeaters value specifies the number of variables in the variable-bindings list for which a single successor is to be returned. =item * The default value for the get-bulk-request B<-maxrepetitions> is 0. The max-repetitions value specifies the number of successors to be returned for the remaining variables in the variable-bindings list. =item * The B<-varbindlist> argument expects an array reference consisting of a list of OBJECT IDENTIFIERs in dotted notation. Each OBJECT IDENTIFER is placed into a single SNMP GetBulkRequest-PDU in the same order that it held in the original list. =back A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. B This method can only be used when the version of the object is set to SNMPv2c or SNMPv3. =cut sub get_bulk_request { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -nonrepeaters -maxrepetitions -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_get_bulk_request(@argv)) { return $this->_error($this->{_pdu}->error()); } return $this->_send_pdu(); } =head2 inform_request() - send a SNMP inform-request to the remote manager $result = $session->inform_request( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -varbindlist => \@oid_value, ); This method is used to provide management information to the remote manager associated with the Net::SNMP object using an inform-request. The message is built using a list of values consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value to be identified. This list is passed to the method as an array reference using the B<-varbindlist> argument. The OBJECT IDENTIFIERs in each trio are to be in dotted notation. The object type is an octet corresponding to the ASN.1 type of value that is to be identified. Each of the supported ASN.1 types have been defined and are exported by the package by default (see L<"EXPORTS">). The first two variable-bindings fields in the inform-request are specified by SNMPv2 and should be: =over =item * sysUpTime.0 - ('1.3.6.1.2.1.1.3.0', TIMETICKS, $timeticks) =item * snmpTrapOID.0 - ('1.3.6.1.6.3.1.1.4.1.0', OBJECT_IDENTIFIER, $oid) =back A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. B This method can only be used when the version of the object is set to SNMPv2c or SNMPv3. =cut sub inform_request { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_inform_request(@argv)) { return $this->_error($this->{_pdu}->error()); } return $this->_send_pdu(); } =head2 snmpv2_trap() - send a SNMP snmpV2-trap to the remote manager $result = $session->snmpv2_trap( [-delay => $seconds,] # non-blocking -varbindlist => \@oid_value, ); This method sends a snmpV2-trap to the remote manager associated with the Net::SNMP object. The message is built using a list of values consisting of groups of an OBJECT IDENTIFIER, an object type, and the actual value to be identified. This list is passed to the method as an array reference using the B<-varbindlist> argument. The OBJECT IDENTIFIERs in each trio are to be in dotted notation. The object type is an octet corresponding to the ASN.1 type of value that is to be identified. Each of the supported ASN.1 types have been defined and are exported by the package by default (see L<"EXPORTS">). The first two variable-bindings fields in the snmpV2-trap are specified by SNMPv2 and should be: =over =item * sysUpTime.0 - ('1.3.6.1.2.1.1.3.0', TIMETICKS, $timeticks) =item * snmpTrapOID.0 - ('1.3.6.1.6.3.1.1.4.1.0', OBJECT_IDENTIFIER, $oid) =back A true value is returned when the method is successful. The undefined value is returned when a failure has occurred. The C method can be used to determine the cause of the failure. Since there are no acknowledgements for SNMPv2-Trap-PDUs, there is no way to determine if the remote host actually received the snmpV2-trap. B When the object is in non-blocking mode, the snmpV2-trap is not sent until the event loop is entered and no callback is ever executed. B This method can only be used when the version of the object is set to SNMPv2c. SNMPv2-Trap-PDUs are supported by SNMPv3, but require the sender of the message to be an authoritative SNMP engine which is not currently supported by the Net::SNMP module. =cut sub snmpv2_trap { my $this = shift; $this->_error_clear(); my @argv; if (!defined $this->_prepare_argv([qw( -delay -contextengineid -contextname -varbindlist )], \@_, \@argv)) { return $this->_error(); } if (!defined $this->_create_pdu()) { return $this->_error(); } if (!defined $this->{_pdu}->prepare_snmpv2_trap(@argv)) { return $this->_error($this->{_pdu}->error()); } $this->_send_pdu(); return defined($this->{_error}) ? $this->_error() : TRUE; } =head2 get_table() - retrieve a table from the remote agent $result = $session->get_table( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -baseoid => $oid, [-maxrepetitions => $max_reps,] # v2c/v3 ); This method performs repeated SNMP get-next-request or get-bulk-request (when using SNMPv2c or SNMPv3) queries to gather data from the remote agent on the host associated with the Net::SNMP object. The first message sent is built using the OBJECT IDENTIFIER in dotted notation passed to the method by the B<-baseoid> argument. Repeated SNMP requests are issued until the OBJECT IDENTIFIER in the response is no longer a child of the base OBJECT IDENTIFIER. The B<-maxrepetitions> argument can be used to specify the max-repetitions value that is passed to the get-bulk-requests when using SNMPv2c or SNMPv3. If this argument is not present, a value is calculated based on the maximum message size for the Net::SNMP object. If the value is set to 1 or less, get-next-requests will be used for the queries instead of get-bulk-requests. A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. B Results from this method can become very large if the base OBJECT IDENTIFIER is close to the root of the SNMP MIB tree. =cut sub get_table { my $this = shift; $this->_error_clear(); my @argv; # Validate the passed arguments. For backwards compatiblity # see if the first argument is an OBJECT IDENTIFIER and then # act accordingly. if ((@_) && ($_[0] =~ m/^\.?\d+(?:\.\d+)* *$/)) { unshift @_, '-baseoid'; # XXX: Side effects? } if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -baseoid -maxrepetitions )], \@_, \@argv)) { return $this->_error(); } if ($argv[0] !~ m/^\.?\d+(?:\.\d+)* *$/) { return $this->_error( 'The base OBJECT IDENTIFIER "%s" is expected in dotted decimal ' . 'notation', $argv[0] ); } # Create a new PDU. if (!defined $this->_create_pdu()) { return $this->_error(); } # Create table of values that need passed along with the # callbacks. This just prevents a big argument list. my $argv = { base_oid => $argv[0], callback => $this->{_pdu}->callback(), max_reps => 5, # Also used as a limit for loop detection. repeat_cnt => 0, table => undef, types => undef, use_bulk => FALSE }; # Override the callback now that we have stored it. $this->{_pdu}->callback( sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error()); } $this->_get_table_cb($argv); return; } ); # Determine if we are going to use get-next-requests or get-bulk-requests # based on the SNMP version and the -maxrepetitions argument. if ($this->version() == SNMP_VERSION_1) { if (defined $argv[1]) { return $this->_error( 'The max-repetitions argument is not applicable when using SNMPv1' ); } } else { if (!defined $argv[1]) { $argv->{use_bulk} = TRUE; $argv->{max_reps} = $this->_msg_size_max_reps(); } elsif ($argv[1] > 1) { $argv->{use_bulk} = TRUE; $argv->{max_reps} = $argv[1]; } } # Create either a get-next-request or get-bulk-request PDU. if ($argv->{use_bulk}) { if (!defined $this->{_pdu}->prepare_get_bulk_request(0, $argv->{max_reps}, [$argv[0]])) { return $this->_error($this->{_pdu}->error()); } } else { if (!defined $this->{_pdu}->prepare_get_next_request([$argv[0]])) { return $this->_error($this->{_pdu}->error()); } } return $this->_send_pdu(); } =head2 get_entries() - retrieve table entries from the remote agent $result = $session->get_entries( [-callback => sub {},] # non-blocking [-delay => $seconds,] # non-blocking [-contextengineid => $engine_id,] # v3 [-contextname => $name,] # v3 -columns => \@columns, [-startindex => $start,] [-endindex => $end,] [-maxrepetitions => $max_reps,] # v2c/v3 ); This method performs repeated SNMP get-next-request or get-bulk-request (when using SNMPv2c or SNMPv3) queries to gather data from the remote agent on the host associated with the Net::SNMP object. Each message specifically requests data for each OBJECT IDENTIFIER specified in the B<-columns> array. The OBJECT IDENTIFIERs must correspond to column entries for a conceptual row in a table. They may however be columns in different tables as long as each table is indexed the same way. The optional B<-startindex> and B<-endindex> arguments may be specified to limit the query to specific rows in the table(s). The B<-startindex> can be specified as a single decimal value or in dotted notation if the index associated with the entry so requires. If the B<-startindex> is specified, it will be include as part of the query results. If no B<-startindex> is specified, the first request message will be sent without an index. To insure that the B<-startindex> is included, the last sub-identifier in the index is decremented by one. If the last sub-identifier has a value of zero, the sub-identifier is removed from the index. The optional B<-endindex> argument can be specified as a single decimal value or in dotted notation. If the B<-endindex> is specified, it will be included as part of the query results. If no B<-endindex> is specified, repeated SNMP requests are issued until the response no longer returns entries matching any of the columns specified in the B<-columns> array. The B<-maxrepetitions> argument can be used to specify the max-repetitions value that is passed to the get-bulk-requests when using SNMPv2c or SNMPv3. If this argument is not present, a value is calculated based on the maximum message size of the object and the number of columns specified in the B<-columns> array. If the value is set to 1 or less, get-next-requests will be used for the queries instead of get-bulk-requests. A reference to a hash is returned in blocking mode which contains the contents of the VarBindList. In non-blocking mode, a true value is returned when no error has occurred. In either mode, the undefined value is returned when an error has occurred. The C method may be used to determine the cause of the failure. =cut sub get_entries { my $this = shift; $this->_error_clear(); my @argv; # Validate the passed arguments. if (!defined $this->_prepare_argv([qw( -callback -delay -contextengineid -contextname -entryoid -columns -startindex -endindex -maxrepetitions -rowcallback )], \@_, \@argv)) { return $this->_error(); } if (ref $argv[1] ne 'ARRAY') { return $this->_error('The columns argument expects an array reference'); } if (!scalar @{$argv[1]}) { return $this->_error('An empty columns list was specified'); } # The syntax of get_entries() changes between release 4.1.0 and # release 4.1.1. For backwards compatibility, we assume the old # syntax is being used if the "-entryoid" argument is present # and we silently convert to the new syntax. if (defined $argv[0]) { # XXX: Argument deprecated after v5.2.0, obsolete in 6.0.1. require Carp; Carp::croak( 'The entryoid argument is obsolete, use the columns argument ' . 'with a list of column OBJECT IDENTIFIERs' ); if ($argv[0] !~ m/^\.?\d+(?:\.\d+)* *$/) { return $this->_error( 'The entryoid value "%s" is expected in dotted decimal notation', $argv[0] ); } my $columns = {}; for (@{$argv[1]}) { if (!m/^\d+$/) { return $this->_error( 'The columns list value "%s" is expected in positive numeric ' . 'format', $_ ); } if (exists $columns->{$_}) { return $this->_error( 'The columns list value "%s" is duplicated in the columns list', $_ ); } else { $columns->{$_} = $_; } } # Now create the new syntax for the columns list. $argv[1] = []; for (sort { $a <=> $b } (keys %{$columns})) { push @{$argv[1]}, join q{.}, $argv[0], $_; } } # Validate the column list. for (@{$argv[1]}) { if (!m/^\.?\d+(?:\.\d+)* *$/) { return $this->_error( 'The columns list OBJECT IDENTIFIER "%s" is expected in dotted ' . 'decimal notation', $_ ); } } my $start_index = undef; if (defined $argv[2]) { if ($argv[2] !~ m/^\d+(?:\.\d+)*$/) { return $this->_error( 'The start index "%s" is expected in dotted decimal notation', $argv[2] ); } my @subids = split m/\./, $argv[2]; if ($subids[-1] > 0) { $subids[-1]--; } else { pop @subids; } $start_index = (@subids) ? join(q{.}, @subids) : q{}; } if (defined $argv[3]) { if ($argv[3] !~ /^\d+(?:\.\d+)*$/) { return $this->_error( 'The end index "%s" is expected in dotted decimal notation', $argv[3] ); } if (defined $argv[2]) { if (oid_lex_cmp($argv[2], $argv[3]) > 0) { return $this->_error( 'The end index cannot be less than the start index' ); } } } # Undocumented and unsupported "-rowcallback" argument. if (defined $argv[5]) { if (ref $argv[5] eq 'CODE') { $argv[5] = [$argv[5]]; } elsif ((ref($argv[5]) ne 'ARRAY') || (ref($argv[5]->[0]) ne 'CODE')) { return $this->_error('The syntax of the row callback is invalid'); } } # Create a new PDU. if (!defined $this->_create_pdu()) { return $this->_error(); } # Create table of values that need passed along with the # callbacks. This just prevents a big argument list. my $argv = { callback => $this->{_pdu}->callback(), columns => $argv[1], end_index => $argv[3], entries => undef, last_index => undef, max_reps => 0, row_callback => $argv[5], start_index => $argv[2], types => undef, use_bulk => FALSE }; # Override the callback now that we have stored it. $this->{_pdu}->callback( sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error()); } $this->_get_entries_cb($argv); return; } ); # Create the varBindList by indexing each column with the start index. my $vbl = [ map { (defined $start_index) ? join q{.}, $_, $start_index : $_ } @{$argv->{columns}} ]; # Determine if we are going to use get-next-requests or get-bulk-requests # based on the SNMP version and the -maxrepetitions argument. if ($this->version() == SNMP_VERSION_1) { if (defined $argv[4]) { return $this->_error( 'The max-repetitions argument is not applicable when using SNMPv1' ); } } else { if (!defined $argv[4]) { $argv->{use_bulk} = TRUE; # Scale the max-repetitions based on the number of columns. $argv->{max_reps} = int($this->_msg_size_max_reps() / @{$argv->{columns}}) + 1; } elsif ($argv[4] > 1) { $argv->{use_bulk} = TRUE; $argv->{max_reps} = $argv[4]; } } # Create either a get-next-request or get-bulk-request PDU. if ($argv->{use_bulk}) { if (!defined $this->{_pdu}->prepare_get_bulk_request(0, $argv->{max_reps}, $vbl)) { return $this->_error($this->{_pdu}->error()); } } else { if (!defined $this->{_pdu}->prepare_get_next_request($vbl)) { return $this->_error($this->{_pdu}->error()); } } return $this->_send_pdu(); } =head2 version() - get the SNMP version from the object $rfc_version = $session->version(); This method returns the current value for the SNMP version associated with the object. The returned value is the corresponding version number defined by the RFCs for the protocol version field (i.e. SNMPv1 == 0, SNMPv2c == 1, and SNMPv3 == 3). The RFC versions are defined as constant by the module and can be exported by request (see L<"EXPORTS">). =cut sub version { my ($this) = @_; return $this->_error('The SNMP version is not modifiable') if (@_ == 2); return $this->{_version}; } =head2 error() - get the current error message from the object $error_message = $session->error(); This method returns a text string explaining the reason for the last error. An empty string is returned if no error has occurred. =cut sub error { return $_[0]->{_error} || q{}; } =head2 hostname() - get the hostname associated with the object $hostname = $session->hostname(); This method returns the parsed hostname string that is associated with the object. Any port information and formatting that can be included with the corresponding C constructor argument will be stripped and not included as part of the returned string. =cut sub hostname { return $_[0]->{_hostname}; } =head2 error_status() - get the current SNMP error-status from the object $error_status = $session->error_status(); This method returns the numeric value of the error-status contained in the last SNMP message received by the object. =cut sub error_status { return defined($_[0]->{_pdu}) ? $_[0]->{_pdu}->error_status() : 0; } =head2 error_index() - get the current SNMP error-index from the object $error_index = $session->error_index(); This method returns the numeric value of the error-index contained in the last SNMP message received by the object. =cut sub error_index { return defined($_[0]->{_pdu}) ? $_[0]->{_pdu}->error_index() : 0; } =head2 var_bind_list() - get the hash reference for the VarBindList values $values = $session->var_bind_list(); This method returns a hash reference created using the ObjectName and the ObjectSyntax pairs in the VarBindList of the last SNMP message received by the object. The keys of the hash consist of the OBJECT IDENTIFIERs in dotted notation corresponding to each ObjectName in the VarBindList. If any of the OBJECT IDENTIFIERs passed to the request method began with a leading dot, all of the OBJECT IDENTIFIER hash keys will be prefixed with a leading dot. If duplicate OBJECT IDENTIFIERs are present in the VarBindList they will be padded with spaces to make them an unique hash key. The value of each hash entry is set equal to the value of the corresponding ObjectSyntax. The undefined value is returned if there has been a failure. =cut sub var_bind_list { return defined($_[0]->{_pdu}) ? $_[0]->{_pdu}->var_bind_list() : undef; } =head2 var_bind_names() - get the array of the ObjectNames in the VarBindList @names = $session->var_bind_names(); This method returns an array containing the OBJECT IDENTIFIERs corresponding to the ObjectNames in the VarBindList in the order that they were received in the last SNMP message. The entries in the array will map directly to the keys in the hash reference returned by the methods that perform SNMP message exchanges and by the C and C methods. The array returned for the convenience methods C and C will be in lexicographical order. An empty array is returned if there has been a failure. =cut sub var_bind_names { return defined($_[0]->{_pdu}) ? @{$_[0]->{_pdu}->var_bind_names()} : (); } =head2 var_bind_types() - get the hash reference for the VarBindList ASN.1 types $types = $session->var_bind_types(); This method returns a hash reference created using the ObjectName and the ASN.1 type of the ObjectSyntax in the VarBindList of the last SNMP message received by the object. The keys of the hash consist of the OBJECT IDENTIFIERs in dotted notation corresponding to each ObjectName in the VarBindList. The value of each hash entry is set equal to the ASN.1 type of the corresponding ObjectSyntax. Constants for the supported ASN.1 types have been defined and are exported by the package by default (see L<"EXPORTS">). The undefined value is returned if there has been a failure. =cut sub var_bind_types { return defined($_[0]->{_pdu}) ? $_[0]->{_pdu}->var_bind_types() : undef; } =head2 timeout() - set or get the current timeout period for the object $seconds = $session->timeout([$seconds]); This method returns the current value for the Transport Layer timeout for the Net::SNMP object. This value is the number of seconds that the object will wait for a response from the agent on the remote host. The default timeout is 5.0 seconds. If a parameter is specified, the timeout for the object is set to the provided value if it falls within the range 1.0 to 60.0 seconds. The undefined value is returned upon an error and the C method may be used to determine the cause. =cut sub timeout { my $this = shift; if (!defined $this->{_transport}) { return $this->_error('The session is closed'); } if (defined (my $timeout = $this->{_transport}->timeout(@_))) { return $timeout; } return $this->_error($this->{_transport}->error()); } =head2 retries() - set or get the current retry count for the object $count = $session->retries([$count]); This method returns the current value for the number of times to retry sending a SNMP message to the remote host. The default number of retries is 1. If a parameter is specified, the number of retries for the object is set to the provided value if it falls within the range 0 to 20. The undefined value is returned upon an error and the C method may be used to determine the cause. =cut sub retries { my $this = shift; if (!defined $this->{_transport}) { return $this->_error('The session is closed'); } if (defined (my $retries = $this->{_transport}->retries(@_))) { return $retries; } return $this->_error($this->{_transport}->error()); } =head2 max_msg_size() - set or get the current maxMsgSize for the object $octets = $session->max_msg_size([$octets]); This method returns the current value for the maximum message size (maxMsgSize) for the Net::SNMP object. This value is the largest message size in octets that can be prepared or processed by the object. The default maxMsgSize is 1472 octets for UDP/IPv4, 1452 octets for UDP/IPv6, 1460 octets for TCP/IPv4, and 1440 octets for TCP/IPv6. If a parameter is specified, the maxMsgSize is set to the provided value if it falls within the range 484 to 65535 octets. The undefined value is returned upon an error and the C method may be used to determine the cause. B When using SNMPv3, the maxMsgSize is actually contained in the SNMP message (as msgMaxSize). If the value received from a remote device is less than the current maxMsgSize, the size is automatically adjusted to be the lower value. =cut sub max_msg_size { my $this = shift; if (!defined $this->{_transport}) { return $this->_error('The session is closed'); } if (defined (my $max_size = $this->{_transport}->max_msg_size(@_))) { return $max_size; } return $this->_error($this->{_transport}->error()); } sub mtu { goto &max_msg_size; } =head2 translate() - enable or disable the translation mode for the object $mask = $session->translate([ $mode | [ # Perl anonymous ARRAY reference ['-all' => $mode0,] ['-octetstring' => $mode1,] ['-null' => $mode2,] ['-timeticks' => $mode3,] ['-opaque' => $mode4,] ['-nosuchobject' => $mode5,] ['-nosuchinstance' => $mode6,] ['-endofmibview' => $mode7,] ['-unsigned' => $mode8] ] ]); When the object decodes the GetResponse-PDU that is returned in response to a SNMP message, certain values are translated into a more "human readable" form. By default the following translations occur: =over =item * OCTET STRINGs and Opaques containing any octet which is not part of the character set defined as a DisplayString in RFC 2679 are converted into a hexadecimal representation prefixed with "0x". The control codes NUL(0x00), BEL(0x07), BS(0x08), HT(0x09), LF(0x0A), VT(0x0b), FF(0x0C), and CR(0x0D) are part of the character set and will not trigger translation. The sequence 'CR x' for any x other than LF or NUL is illegal and will trigger translation. =item * TimeTicks integer values are converted to a time format. =item * NULL values return the string "NULL" instead of an empty string. =item * noSuchObject exception values return the string "noSuchObject" instead of an empty string. =item * noSuchInstance exception values return the string "noSuchInstance" instead of an empty string. =item * endOfMibView exception values return the string "endOfMibView" instead of an empty string. =item * Counter64, Counter, Gauge, and TimeTick values that have been incorrectly encoded as signed negative values are returned as unsigned values. =back The C method can be invoked with two different types of arguments. If the argument passed is any Perl variable type except an array reference, the translation mode for all ASN.1 types is set to either enabled or disabled, depending on the value of the passed parameter. Any value that Perl would treat as a true value will set the mode to be enabled for all types, while a false value will disable translation for all types. A reference to an array can be passed to the C method in order to define the translation mode on a per ASN.1 type basis. The array is expected to contain a list of named argument pairs for each ASN.1 type that is to be modified. The arguments in the list are applied in the order that they are passed in via the array. Arguments at the end of the list supercede those passed earlier in the list. The argument "-all" can be used to specify that the mode is to apply to all ASN.1 types. Only the arguments for the ASN.1 types that are to be modified need to be included in the list. The C method returns a bit mask indicating which ASN.1 types are to be translated. Definitions of the bit to ASN.1 type mappings can be exported using the I<:translate> tag (see L<"EXPORTS">). The undefined value is returned upon an error and the C method may be used to determine the cause. =cut sub translate { my ($this, $mask) = @_; if (@_ != 2) { return $this->{_translate}; } if (ref($mask) ne 'ARRAY') { # Behave like we did before, do (not) translate everything $this->_translate_mask($_[1], TRANSLATE_ALL); } else { # Allow the user to turn off and on specific translations. An # array is used so the order of the arguments controls how the # mask is defined. my @argv = @{$mask}; my $arg; while (defined ($arg = shift @argv)) { if ($arg =~ /^-?all$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_ALL); } elsif ($arg =~ /^-?none$/i) { $this->_translate_mask(!(shift @argv), TRANSLATE_ALL); } elsif ($arg =~ /^-?octet_?string$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_OCTET_STRING); } elsif ($arg =~ /^-?null$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_NULL); } elsif ($arg =~ /^-?timeticks$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_TIMETICKS); } elsif ($arg =~ /^-?opaque$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_OPAQUE); } elsif ($arg =~ /^-?nosuchobject$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_NOSUCHOBJECT); } elsif ($arg =~ /^-?nosuchinstance$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_NOSUCHINSTANCE); } elsif ($arg =~ /^-?endofmibview$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_ENDOFMIBVIEW); } elsif ($arg =~ /^-?unsigned$/i) { $this->_translate_mask(shift(@argv), TRANSLATE_UNSIGNED); } else { return $this->_error( 'The translate argument "%s" is unknown', $arg ); } } } DEBUG_INFO('translate mask = 0x%02x', $this->{_translate}); return $this->{_translate}; } =head2 debug() - set or get the debug mode for the module $mask = $session->debug([$mask]); This method is used to enable or disable debugging for the Net::SNMP module. Debugging can be enabled on a per component level as defined by a bit mask passed to the C method. The bit mask is broken up as follows: =over =item * 0x02 - Message or PDU encoding and decoding =item * 0x04 - Transport Layer =item * 0x08 - Dispatcher =item * 0x10 - Message Processing =item * 0x20 - Security =back Symbols representing these bit mask values are defined by the module and can be exported using the I<:debug> tag (see L<"EXPORTS">). If a non-numeric value is passed to the C method, it is evaluated in boolean context. Debugging for all of the components is then enabled or disabled based on the resulting truth value. The current debugging mask is returned by the method. Debugging can also be enabled using the stand alone function C. This function can be exported by request (see L<"EXPORTS">). =cut sub debug { my (undef, $mask) = @_; if (@_ == 2) { $DEBUG = ($mask =~ /^\d+$/) ? $mask : ($mask) ? DEBUG_ALL : DEBUG_NONE; eval { Net::SNMP::Message->debug($DEBUG & DEBUG_MESSAGE); }; eval { Net::SNMP::Transport->debug($DEBUG & DEBUG_TRANSPORT); }; eval { Net::SNMP::Dispatcher->debug($DEBUG & DEBUG_DISPATCHER); }; eval { Net::SNMP::MessageProcessing->debug($DEBUG & DEBUG_PROCESSING); }; eval { Net::SNMP::Security->debug($DEBUG & DEBUG_SECURITY); }; } return $DEBUG; } sub snmp_debug { return debug(undef, $_[0]); } sub pdu { return $_[0]->{_pdu}; } sub nonblocking { return $_[0]->{_nonblocking}; } sub security { return $_[0]->{_security}; } sub transport { return $_[0]->{_transport}; } =head1 SUBROUTINES =head2 oid_base_match() - determine if an OID has a specified OID base $value = oid_base_match($base_oid, $oid); This function takes two OBJECT IDENTIFIERs in dotted notation and returns a true value (i.e. 0x1) if the second OBJECT IDENTIFIER is equal to or is a child of the first OBJECT IDENTIFIER in the SNMP Management Information Base (MIB). This function can be used in conjunction with the C or C methods to determine when a OBJECT IDENTIFIER in the GetResponse-PDU is no longer in the desired MIB tree branch. =cut sub oid_base_match { my ($base, $oid) = @_; defined $base || return FALSE; defined $oid || return FALSE; $base =~ s/^\.//o; $oid =~ s/^\.//o; $base = pack 'N*', split m/\./, $base; $oid = pack 'N*', split m/\./, $oid; return (substr($oid, 0, length $base) eq $base) ? TRUE : FALSE; } sub oid_context_match { require Carp; Carp::croak( 'oid_context_match() is obsolete, use oid_base_match() instead' ); goto &oid_base_match; } =head2 oid_lex_cmp() - compare two OBJECT IDENTIFIERs lexicographically $cmp = oid_lex_cmp($oid1, $oid2); This function takes two OBJECT IDENTIFIERs in dotted notation and returns one of the values 1, 0, -1 if $oid1 is respectively lexicographically greater, equal, or less than $oid2. =cut sub oid_lex_cmp { my ($aa, $bb) = @_; for ($aa, $bb) { s/^\.//; s/ /\.0/g; $_ = pack 'N*', split m/\./; } return $aa cmp $bb; } =head2 oid_lex_sort() - sort a list of OBJECT IDENTIFIERs lexicographically @sorted_oids = oid_lex_sort(@oids); This function takes a list of OBJECT IDENTIFIERs in dotted notation and returns the listed sorted in lexicographical order. =cut sub oid_lex_sort { if (@_ <= 1) { return @_; } return map { $_->[0] } sort { $a->[1] cmp $b->[1] } map { my $oid = $_; $oid =~ s/^\.//; $oid =~ s/ /\.0/g; [$_, pack 'N*', split m/\./, $oid] } @_; } =head2 snmp_type_ntop() - convert an ASN.1 type to presentation format $text = snmp_type_ntop($type); This function takes an ASN.1 type octet and returns a text string suitable for presentation. Some ASN.1 type definitions map to the same octet value when encoded. This method cannot distinguish between these multiple mappings and the most basic type name will be returned. =cut sub snmp_type_ntop { goto &asn1_itoa; } =head2 ticks_to_time() - convert TimeTicks to formatted time $time = ticks_to_time($timeticks); This function takes an ASN.1 TimeTicks value and returns a string representing the time defined by the value. The TimeTicks value is expected to be a non-negative integer value representing the time in hundredths of a second since some epoch. The returned string will display the time in days, hours, and seconds format according to the value of the TimeTicks argument. =cut sub ticks_to_time { goto &asn1_ticks_to_time; } sub DESTROY { my ($this) = @_; # We decrement the object type count when the object goes out of # existance. We assume that _object_type_validate() was called for # every creation or else we die. if ($this->{_nonblocking}) { if (--$NONBLOCKING < 0) { die 'FATAL: Invalid non-blocking object count'; } } else { if (--$BLOCKING < 0) { die 'FATAL: Invalid blocking object count'; } } } # [private methods] ---------------------------------------------------------- sub _send_pdu { my ($this) = @_; # Check to see if we are still in the process of discovering the # authoritative SNMP engine. If we are, queue the PDU if we are # running in non-blocking mode. if ($this->{_nonblocking} && !$this->{_security}->discovered()) { push @{$this->{_discovery_queue}}, [$this->{_pdu}, $this->{_delay}]; return TRUE; } # Hand the PDU off to the Dispatcher $DISPATCHER->send_pdu($this->{_pdu}, $this->{_delay}); # Activate the dispatcher if we are blocking if (!$this->{_nonblocking}) { snmp_dispatcher(); } # Return according to blocking mode return ($this->{_nonblocking}) ? TRUE : $this->var_bind_list(); } sub _create_pdu { my ($this) = @_; # Create the new PDU ($this->{_pdu}, $this->{_error}) = Net::SNMP::PDU->new( -version => $this->{_version}, -security => $this->{_security}, -transport => $this->{_transport}, -translate => $this->{_translate}, -callback => $this->_callback_closure(), -requestid => $DISPATCHER->msg_handle_alloc(), defined($this->{_context_engine_id}) ? (-contextengineid => $this->{_context_engine_id}) : (), defined($this->{_context_name}) ? (-contextname => $this->{_context_name}) : (), ); if (!defined $this->{_pdu}) { return $this->_error(); } $this->_error_clear(); # Return the PDU return $this->{_pdu}; } { my $versions = { '(?:snmp)?v?1', SNMP_VERSION_1, '(?:snmp)?v?2c?', SNMP_VERSION_2C, '(?:snmp)?v?3', SNMP_VERSION_3, }; sub _version { my ($this, $version) = @_; # XXX: The passed $version is updated as a side effect. # Clear any previous error message. $this->_error_clear(); if ($version eq q{}) { return $this->_error('An empty SNMP version was specified'); } for (keys %{$versions}) { if ($version =~ m/^$_$/i) { $_[1] = $this->{_version} = $versions->{$_}; return TRUE; } } return $this->_error('The SNMP version "%s" is unknown', $version); } } { # Arguments that apply to the object. my $obj_args = { -callback => \&_callback, # non-blocking only -contextengineid => \&_context_engine_id, # v3 only -contextname => \&_context_name, # v3 only -delay => \&_delay, # non-blocking only }; sub _prepare_argv { my ($this, $allowed, $named, $unnamed) = @_; # XXX: Argument $unnamed is updated by reference. my %argv; # For backwards compatibility, check to see if the first # argument is an OBJECT IDENTIFIER in dotted notation. If it # is, assign it to the -varbindlist argument. if ((@{$named}) && ($named->[0] =~ m/^\.?\d+(?:\.\d+)* *$/)) { $argv{-varbindlist} = $named; } else { %argv = @{$named}; } # Go through the passed argument list and see if the argument is # allowed. If it is, see if it applies to the object and has a # matching method call or add it the the new argv list to be # returned by this method. my %new_args; for my $key (keys %argv) { my @match = grep { /^-?\Q$key\E$/i } @{$allowed}; if (@match == 1) { if (exists $obj_args->{$match[0]}) { if (!defined $this->${\$obj_args->{$match[0]}}($argv{$key})) { return $this->_error(); } } else { $new_args{$match[0]} = $argv{$key}; } } else { return $this->_error('The argument "%s" is unknown', $key); } } # Create a new ordered unnamed argument list based on the allowed # list passed, ignoring those that applied to the object. for (@{$allowed}) { next if exists $obj_args->{$_}; push @{$unnamed}, exists($new_args{$_}) ? $new_args{$_} : undef; } return TRUE; } } sub _callback { my ($this, $callback) = @_; # We validate the callback argument and then create an anonymous # array where the first element is the subroutine reference and # the second element is an array reference containing arguments # to pass to the subroutine. if (!$this->{_nonblocking}) { return $this->_error( 'The callback argument is not applicable to blocking objects' ); } my @argv; if (!defined $callback) { $this->{_callback} = undef; return TRUE; } elsif ((ref($callback) eq 'ARRAY') && (ref($callback->[0]) eq 'CODE')) { ($callback, @argv) = @{$callback}; } elsif (ref($callback) ne 'CODE') { return $this->_error('The syntax of the callback is invalid'); } $this->{_callback} = [$callback, \@argv]; return TRUE; } sub _callback_closure { my ($this) = @_; # When a response message is received, the Dispatcher will create # a new PDU object and assign the callback to that object. The # callback is then executed passing a reference to the PDU object # as the first argument. We use a closure to assign that passed # reference to the Net:SNMP object and then invoke the user defined # callback. if (!$this->{_nonblocking} || !defined $this->{_callback}) { return sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error()); } return; }; } my ($callback, $argv) = @{$this->{_callback}}; return sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error()); } $callback->($this, @{$argv}); return; }; } sub _context_engine_id { my ($this, $context_engine_id) = @_; $this->_error_clear(); if ($this->version() != SNMP_VERSION_3) { return $this->_error( 'The contextEngineID argument is only supported in SNMPv3' ); } if (!defined $context_engine_id) { $this->{_context_engine_id} = undef; } elsif ($context_engine_id =~ m/^(?:0x)?([A-F0-9]+)$/i) { my $cei = pack 'H*', length($1) % 2 ? '0'.$1 : $1; my $len = length $cei; if ($len < 5 || $len > 32) { return $this->_error( 'The contextEngineID length of %d is out of range (5..32)', $len ); } $this->{_context_engine_id} = $cei; } else { return $this->_error( 'The contextEngineID "%s" is expected in hexadecimal format', $context_engine_id ); } return TRUE; } sub _context_name { my ($this, $context_name) = @_; $this->_error_clear(); if ($this->version() != SNMP_VERSION_3) { return $this->_error( 'The contextName argument is only supported in SNMPv3' ); } if (!defined $context_name) { $this->{_context_name} = undef; } elsif (length($context_name) <= 32) { $this->{_context_name} = $context_name; } else { return $this->_error( 'The contextName length of %d is out of range (0..32)', length $context_name ); } return TRUE; } sub _delay { my ($this, $delay) = @_; $this->_error_clear(); if (!$this->{_nonblocking}) { return $this->_error( 'The delay argument is not applicable to blocking objects' ); } if ($delay !~ /^\d+(?:\.\d+)?$/) { return $this->_error( 'The delay value "%s" is expected in positive numeric format', $delay ); } if ($delay < 0 || $delay > 31556926) { # Seconds in a year... return $this->_error( 'The delay value "%s" is out of range (0..31556926)', $delay ); } $this->{_delay} = $delay; return TRUE; } sub _object_type_validate { my ($this) = @_; # Since both non-blocking and blocking objects use the same # Dispatcher instance, allowing both objects types to exist at # the same time would cause problems. This method is called # by the constructor to track the object counts based on the # non-blocking property and returns an error if the two types # would exist at the same time. my $count = ($this->{_nonblocking}) ? ++$NONBLOCKING : ++$BLOCKING; if ($this->{_nonblocking} && $BLOCKING) { return $this->_error( 'Cannot create non-blocking objects when blocking objects exist' ); } elsif (!$this->{_nonblocking} && $NONBLOCKING) { return $this->_error( 'Cannot create blocking objects when non-blocking objects exist' ); } return $count; } sub _perform_discovery { my ($this) = @_; return TRUE if ($this->{_security}->discovered()); # RFC 3414 - Section 4: "Discovery... ...may be accomplished by # generating a Request message with a securityLevel of noAuthNoPriv, # a msgUserName of zero-length, a msgAuthoritativeEngineID value of # zero length, and the varBindList left empty." # Create a new PDU if (!defined $this->_create_pdu()) { return $this->_discovery_failed(); } # Create the callback and assign it to the PDU $this->{_pdu}->callback( sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error() . ' during discovery'); } $this->_discovery_engine_id_cb(); return; } ); # Prepare an empty get-request if (!defined $this->{_pdu}->prepare_get_request()) { $this->_error($this->{_pdu}->error()); return $this->_discovery_failed(); } # Send the PDU $DISPATCHER->send_pdu($this->{_pdu}, 0); if (!$this->{_nonblocking}) { snmp_dispatcher(); } return ($this->{_error}) ? $this->_error() : TRUE; } sub _discovery_engine_id_cb { my ($this) = @_; # "The response to this message will be a Report message containing # the snmpEngineID of the authoritative SNMP engine... ...with the # usmStatsUnknownEngineIDs counter in the varBindList." If another # error is returned, we assume snmpEngineID discovery has failed. if ($this->{_error} !~ /usmStatsUnknownEngineIDs/) { return $this->_discovery_failed(); } # Clear the usmStatsUnknownEngineIDs error $this->_error_clear(); # If the security model indicates that discovery is complete, # we send any pending messages and return success. If discovery # is not complete, we probably need to synchronize with the # remote authoritative engine. if ($this->{_security}->discovered()) { DEBUG_INFO('discovery complete'); return $this->_discovery_complete(); } # "If authenticated communication is required, then the discovery # process should also establish time synchronization with the # authoritative SNMP engine. This may be accomplished by sending # an authenticated Request message..." # Create a new PDU if (!defined $this->_create_pdu()) { return $this->_discovery_failed(); } # Create the callback and assign it to the PDU $this->{_pdu}->callback( sub { $this->{_pdu} = $_[0]; $this->_error_clear(); if ($this->{_pdu}->error()) { $this->_error($this->{_pdu}->error() . ' during synchronization'); } $this->_discovery_synchronization_cb(); return; } ); # Prepare an empty get-request if (!defined $this->{_pdu}->prepare_get_request()) { $this->_error($this->{_pdu}->error()); return $this->_discovery_failed(); } # Send the PDU $DISPATCHER->send_pdu($this->{_pdu}, 0); if (!$this->{_nonblocking}) { snmp_dispatcher(); } return ($this->{_error}) ? $this->_error() : TRUE; } sub _discovery_synchronization_cb { my ($this) = @_; # "The response... ...will be a Report message containing the up # to date values of the authoritative SNMP engine's snmpEngineBoots # and snmpEngineTime... It also contains the usmStatsNotInTimeWindows # counter in the varBindList..." If another error is returned, we # assume that the synchronization has failed. if (($this->{_security}->discovered()) && ($this->{_error} =~ /usmStatsNotInTimeWindows/)) { $this->_error_clear(); DEBUG_INFO('discovery and synchronization complete'); return $this->_discovery_complete(); } # If we received the usmStatsNotInTimeWindows report or no error, but # we are still not synchronized, provide a generic error message. if ((!$this->{_error}) || ($this->{_error} =~ /usmStatsNotInTimeWindows/)) { $this->_error_clear(); $this->_error('Time synchronization failed during discovery'); } DEBUG_INFO('synchronization failed'); return $this->_discovery_failed(); } sub _discovery_failed { my ($this) = @_; # The discovery process has failed, clear the current PDU and the # Transport Domain so no one can use this object to send messages. $this->{_pdu} = undef; $this->{_transport} = undef; # Inform the command generator about the current error. while (my $q = shift @{$this->{_discovery_queue}}) { $q->[0]->status_information($this->{_error}); } return $this->_error(); } sub _discovery_complete { my ($this) = @_; # Discovery is complete, send any pending messages. while (my $q = shift @{$this->{_discovery_queue}}) { $DISPATCHER->send_pdu(@{$q}); } return ($this->{_error}) ? $this->_error() : TRUE; } sub _translate_mask { my ($this, $enable, $mask) = @_; # Define the translate bitmask for the object based on the # passed truth value and mask. if ($enable) { $this->{_translate} |= $mask; # Enable } else { $this->{_translate} &= ~$mask; # Disable } return $this->{_translate}; } sub _msg_size_max_reps { my ($this) = @_; # Use the maxMsgSize of the object to produce a max-repetitions # value. This is an attempt to avoid exceeding the maxMsgSize # in the responses to get-bulk-requests. The scaling factor # of 0.017 produces a value of 25 with the default maxMsgSize of # 1472. This was the old hardcoded value used by get_table(). if (!defined $this->{_transport}) { return 25; } return int $this->{_transport}->max_msg_size() * 0.017; } sub _get_table_cb { my ($this, $argv) = @_; # Use get-next-requests or get-bulk-requests until the response is # not a subtree of the base OBJECT IDENTIFIER. Return the table only # if there are no errors other than a noSuchName(2) error since the # table could be at the end of the tree. Also return the table when # the value of the OID equals endOfMibView(2) when using SNMPv2c. # Get the current callback. my $callback = $this->{_pdu}->callback(); # Assign the user callback to the PDU. $this->{_pdu}->callback($argv->{callback}); my $list = $this->var_bind_list(); my $types = $this->var_bind_types(); my @names = $this->var_bind_names(); my $next = undef; while (@names) { $next = shift @names; # Check to see if we are still in the correct subtree and have # not received a endOfMibView exception. if (!oid_base_match($argv->{base_oid}, $next) || ($types->{$next} == ENDOFMIBVIEW)) { $next = undef; # End of table. last; } # Add the entry to the table only if it is not already present # and check to make sure that the remote host does not respond # incorrectly causing the requests to loop forever. if (!exists $argv->{table}->{$next}) { $argv->{table}->{$next} = $list->{$next}; $argv->{types}->{$next} = $types->{$next}; } elsif (++$argv->{repeat_cnt} > $argv->{max_reps}) { $this->{_pdu}->status_information( 'A loop was detected with the table on the remote host' ); return; } } # Queue the next request if we are not at the end of the table. if (defined $next) { $this->_get_table_entries_request_next($argv, $callback, [$next]); return; } # Clear the PDU error on a noSuchName(2) error status. if ($this->error_status() == 2) { $this->{_pdu}->error(undef); } # Check for an empty or nonexistent table. if (!$this->{_pdu}->error() && !defined $argv->{table}) { $this->{_pdu}->error('The requested table is empty or does not exist'); } # Copy the table to the var_bind_list. $this->{_pdu}->var_bind_list($argv->{table}, $argv->{types}); # Notify the command generator to process the results. $this->{_pdu}->process_response_pdu(); return; } sub _get_entries_cb { my ($this, $argv) = @_; # Get the current callback. my $callback = $this->{_pdu}->callback(); # Assign the user callback to the PDU. $this->{_pdu}->callback($argv->{callback}); # Iterate through the response OBJECT IDENTIFIERs. The response(s) # will (should) be grouped in the same order as the columns that # were requested. We use this assumption to map the response(s) to # get-next/bulk-requests. When using get-bulk-requests, "holes" in # the table may cause certain columns to run ahead or behind other # columns, so we cache all entries and sort it out when processing # the row. my $list = $this->var_bind_list(); my $types = $this->var_bind_types(); my @names = $this->var_bind_names(); my $max_index = (defined $argv->{last_index}) ? $argv->{last_index} : '0'; my $last_entry = TRUE; my $cache = {}; while (@names) { my @row = (); my $row_index = undef; # Match up the responses to the requested columns. for my $col_num (0 .. $#{$argv->{columns}}) { my $name = shift @names; if (!defined $name) { # Due to transport layer limitations, the response could have # been truncated, so do not consider this the last entry. DEBUG_INFO('column number / oid number mismatch'); $last_entry = FALSE; @row = (); last; } my $column = quotemeta $argv->{columns}->[$col_num]; my $index; if ($name =~ m/$column\.(\d+(:?\.\d+)*)/) { # Requested column and response column match up. $index = $1; } else { # The response column does not map to the the request, there # could be a "hole" or we are out of entries. DEBUG_INFO('last_entry: column mismatch: %s', $name); $last_entry = TRUE; next; } DEBUG_INFO('found index [%s]', $index); # Validate the index of the response. if ((defined $argv->{start_index}) && (oid_lex_cmp($index, $argv->{start_index}) < 0)) { DEBUG_INFO( 'index [%s] less than start_index [%s]', $index, $argv->{start_index} ); if (oid_lex_cmp($index, $max_index) > 0) { $max_index = $index; $last_entry = FALSE; DEBUG_INFO('new max_index [%s]', $max_index); } next; } elsif ((defined $argv->{end_index}) && (oid_lex_cmp($index, $argv->{end_index}) > 0)) { DEBUG_INFO( 'last_entry: index [%s] greater than end_index [%s]', $index, $argv->{end_index} ); $last_entry = TRUE; next; } # Cache the current column since it falls into the requested range. $cache->{$index}->[$col_num] = $name; # To handle "holes" in the conceptual row, checks need to be made # so that the lowest index for each group of responses is used. if (!defined $row_index) { $row_index = $index; } my $index_cmp = oid_lex_cmp($index, $row_index); if ($index_cmp == 0) { # The index for this response entry matches, so fill in # the corresponding row entry. $row[$col_num] = $name; } elsif ($index_cmp < 0) { # The index for this response is less than the current index, # so we throw out everything and start over. @row = (); $row_index = $index; $row[$col_num] = $name; DEBUG_INFO('new minimum row_index [%s]', $row_index); } else { # There must be a "hole" in the row, do nothing here since this # entry was cached and will hopefully be taken care of later. DEBUG_INFO( 'index [%s] greater than current row_index [%s]', $index, $row_index ); } } # No row information found, continue. if (!@row || !defined $row_index) { next; } # Now store the results for the conceptual row. for my $col_num (0 .. $#{$argv->{columns}}) { # Check for cached values that may have been lost due to "holes". if (!defined $row[$col_num]) { if (defined $cache->{$row_index}->[$col_num]) { DEBUG_INFO('using cache: %s', $cache->{$row_index}->[$col_num]); $row[$col_num] = $cache->{$row_index}->[$col_num]; } else { next; } } # Actually store the results. if (!exists $argv->{entries}->{$row[$col_num]}) { $last_entry = FALSE; $argv->{entries}->{$row[$col_num]} = $list->{$row[$col_num]}; $argv->{types}->{$row[$col_num]} = $types->{$row[$col_num]}; } else { DEBUG_INFO('not adding duplicate: %s', $row[$col_num]); } } # Execute the row callback if it is defined. $this->_get_entries_exec_row_cb($argv, $row_index, \@row); # Store the maximum index found to be used for the next request. if (oid_lex_cmp($row_index, $max_index) > 0) { $max_index = $row_index; DEBUG_INFO('new max_index [%s]', $max_index); } } # Make sure we are not stuck (looping) on a single index. if (defined $argv->{last_index}) { if (oid_lex_cmp($max_index, $argv->{last_index}) > 0) { $argv->{last_index} = $max_index; } elsif ($last_entry == FALSE) { DEBUG_INFO( 'last_entry: max_index [%s] not greater than last_index [%s])', $max_index, $argv->{last_index} ); $last_entry = TRUE; } } else { $argv->{last_index} = $max_index; } # If we have not reached the last requested entry, generate another # get-next/bulk-request message. if ($last_entry == FALSE) { my $vbl = [ map { join q{.}, $_, $max_index } @{$argv->{columns}} ]; $this->_get_table_entries_request_next($argv, $callback, $vbl); return; } # Clear the PDU error on a noSuchName(2) error status. if ($this->error_status() == 2) { $this->{_pdu}->error(undef); } # Check for an empty or nonexistent table. if (!$this->{_pdu}->error() && !defined $argv->{entries}) { $this->{_pdu}->error('The requested entries are empty or do not exist'); } # Copy the table to the var_bind_list. $this->{_pdu}->var_bind_list($argv->{entries}, $argv->{types}); # Execute the row callback, if there has been an error. if ($this->{_pdu}->error()) { $this->_get_entries_exec_row_cb($argv, 0, []); } # Notify the command generator to process the results. $this->{_pdu}->process_response_pdu(); return; } sub _get_table_entries_request_next { my ($this, $argv, $callback, $vbl) = @_; # Copy the current PDU for use in error conditions. my $pdu = $this->{_pdu}; # Create a new PDU. if (!defined $this->_create_pdu()) { $pdu->status_information($this->error()); return; } # Override the callback with the saved callback. $this->{_pdu}->callback($callback); # Use the contextEngineID and contextName from the previous request # because the values stored in the object could change. if (defined $pdu->context_engine_id()) { $this->{_pdu}->context_engine_id($pdu->context_engine_id()); } if (defined $pdu->context_name()) { $this->{_pdu}->context_name($pdu->context_name()); } # Create the appropriate request. if ($argv->{use_bulk}) { if (!defined $this->{_pdu}->prepare_get_bulk_request(0, $argv->{max_reps}, $vbl)) { $pdu->status_information($this->{_pdu}->error()); return; } } else { if (!defined $this->{_pdu}->prepare_get_next_request($vbl)) { $pdu->status_information($this->{_pdu}->error()); return; } } # Send the next PDU with no delay. $DISPATCHER->send_pdu($this->{_pdu}, 0); return; } sub _get_entries_exec_row_cb { my ($this, $argv, $index, $row) = @_; return if !defined $argv->{row_callback}; my ($cb, @argv) = @{$argv->{row_callback}}; # Add the "values" found for each column to the front of the # callback argument list. for (my $col_num = $#{$argv->{columns}}; $col_num >= 0; --$col_num) { if (defined $row->[$col_num]) { unshift @argv, $argv->{entries}->{$row->[$col_num]}; } else { unshift @argv, undef; } } # Prepend the index for the conceptual row. unshift @argv, $index; return eval { $cb->(@argv); }; } sub _error { my $this = shift; # If the PDU callback is still defined when an error occurs, it # needs to be cleared to prevent the closure from holding up the # reference count of the object that created the closure. if (defined $this->{_pdu} && defined $this->{_pdu}->callback()) { $this->{_pdu}->callback(undef); } 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 require_version { my ($this, @argv) = @_; # Provide our own method for handling x.y.z version checks and the return # value of VERISON() in older implementations of Perl. V-string versions # in Perl 5.10.0 are now treated as version objects and handled properly. if (@argv > 0) { my $wanted = $argv[0]; if ($wanted =~ /(\d+)\.(\d{1,3})\.(\d{1,3})/) { $argv[0] = sprintf '%d.%03d%03d', $1, $2, $3; } } my $version = eval { sprintf '%d.%03d%03d', unpack 'C*', $this->UNIVERSAL::VERSION(@argv); }; if ($@) { local $_ = $@; s/ at(?:.*)\n//; require Carp; Carp::croak($_); } return $version; } sub DEBUG_INFO { return $DEBUG if (!$DEBUG); return printf sprintf('debug: [%d] %s(): ', (caller 0)[2], (caller 1)[3]) . ((@_ > 1) ? shift(@_) : '%s') . "\n", @_; } # [end Net::SNMP code] ------------------------------------------------------- 1; __END__ # [documentation] ------------------------------------------------------------ =head1 EXPORTS The Net::SNMP module uses the F module to export useful constants and subroutines. These exportable symbols are defined below and follow the rules and conventions of the F module (see L). =over =item Default &snmp_dispatcher, INTEGER, INTEGER32, OCTET_STRING, OBJECT_IDENTIFIER, IPADDRESS, COUNTER, COUNTER32, GAUGE, GAUGE32, UNSIGNED32, TIMETICKS, OPAQUE, COUNTER64, NOSUCHOBJECT, NOSUCHINSTANCE, ENDOFMIBVIEW =item Exportable &snmp_debug, &snmp_dispatcher, &snmp_type_ntop, &oid_base_match, &oid_lex_cmp, &oid_lex_sort,&ticks_to_time, 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, DEBUG_ALL, DEBUG_NONE, DEBUG_MESSAGE, DEBUG_TRANSPORT, DEBUG_DISPATCHER,DEBUG_PROCESSING, DEBUG_SECURITY, COLD_START, WARM_START, LINK_DOWN, LINK_UP, AUTHENTICATION_FAILURE, EGP_NEIGHBOR_LOSS, ENTERPRISE_SPECIFIC, SNMP_VERSION_1, SNMP_VERSION_2C, SNMP_VERSION_3, SNMP_PORT, SNMP_TRAP_PORT, TRANSLATE_NONE,TRANSLATE_OCTET_STRING, TRANSLATE_NULL, TRANSLATE_TIMETICKS, TRANSLATE_OPAQUE,TRANSLATE_NOSUCHOBJECT, TRANSLATE_NOSUCHINSTANCE, TRANSLATE_ENDOFMIBVIEW, TRANSLATE_UNSIGNED, TRANSLATE_ALL =item Tags =over =item :asn1 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 =item :debug &snmp_debug, DEBUG_ALL, DEBUG_NONE, DEBUG_MESSAGE, DEBUG_TRANSPORT, DEBUG_DISPATCHER, DEBUG_PROCESSING, DEBUG_SECURITY =item :generictrap COLD_START, WARM_START, LINK_DOWN, LINK_UP, AUTHENTICATION_FAILURE, EGP_NEIGHBOR_LOSS, ENTERPRISE_SPECIFIC =item :snmp &snmp_debug, &snmp_dispatcher, &snmp_type_ntop, &oid_base_match, &oid_lex_cmp, &oid_lex_sort, &ticks_to_time, SNMP_VERSION_1, SNMP_VERSION_2C, SNMP_VERSION_3, SNMP_PORT, SNMP_TRAP_PORT =item :translate TRANSLATE_NONE, TRANSLATE_OCTET_STRING, TRANSLATE_NULL, TRANSLATE_TIMETICKS, TRANSLATE_OPAQUE, TRANSLATE_NOSUCHOBJECT, TRANSLATE_NOSUCHINSTANCE, TRANSLATE_ENDOFMIBVIEW, TRANSLATE_UNSIGNED, TRANSLATE_ALL =item :ALL All of the above exportable items. =back =back =head1 EXAMPLES =head2 1. Blocking SNMPv1 get-request for sysUpTime This example gets the sysUpTime from a remote host. #! /usr/local/bin/perl use strict; use warnings; use Net::SNMP; my $OID_sysUpTime = '1.3.6.1.2.1.1.3.0'; my ($session, $error) = Net::SNMP->session( -hostname => shift || 'localhost', -community => shift || 'public', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my $result = $session->get_request(-varbindlist => [ $OID_sysUpTime ],); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); $session->close(); exit 1; } printf "The sysUpTime for host '%s' is %s.\n", $session->hostname(), $result->{$OID_sysUpTime}; $session->close(); exit 0; =head2 2. Blocking SNMPv3 set-request of sysContact This example sets the sysContact information on the remote host to "Help Desk x911". The named arguments passed to the C constructor are for the demonstration of syntax only. These parameters will need to be set according to the SNMPv3 parameters of the remote host. The C utility included with the distribution can be used to create the key values. #! /usr/local/bin/perl use strict; use warnings; use Net::SNMP; my $OID_sysContact = '1.3.6.1.2.1.1.4.0'; my ($session, $error) = Net::SNMP->session( -hostname => 'myv3host.example.com', -version => 'snmpv3', -username => 'myv3Username', -authprotocol => 'sha1', -authkey => '0x6695febc9288e36282235fc7151f128497b38f3f', -privprotocol => 'des', -privkey => '0x6695febc9288e36282235fc7151f1284', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my $result = $session->set_request( -varbindlist => [ $OID_sysContact, OCTET_STRING, 'Help Desk x911' ], ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); $session->close(); exit 1; } printf "The sysContact for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysContact}; $session->close(); exit 0; =head2 3. Non-blocking SNMPv2c get-bulk-request for ifTable This example gets the contents of the ifTable by sending get-bulk-requests until the responses are no longer part of the ifTable. The ifTable can also be retrieved using the C method. The ifPhysAddress object in the table has a syntax of an OCTET STRING. By default, translation is enabled and non-printable OCTET STRINGs are translated into a hexadecimal format. Sometimes the OCTET STRING contains all printable characters and this produces unexpected output when it is not translated. The example turns off translation for OCTET STRINGs and specifically formats the output for the ifPhysAddress objects. #! /usr/local/bin/perl use strict; use warnings; use Net::SNMP qw(:snmp); my $OID_ifTable = '1.3.6.1.2.1.2.2'; my $OID_ifPhysAddress = '1.3.6.1.2.1.2.2.1.6'; my ($session, $error) = Net::SNMP->session( -hostname => shift || 'localhost', -community => shift || 'public', -nonblocking => 1, -translate => [-octetstring => 0], -version => 'snmpv2c', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my %table; # Hash to store the results my $result = $session->get_bulk_request( -varbindlist => [ $OID_ifTable ], -callback => [ \&table_callback, \%table ], -maxrepetitions => 10, ); if (!defined $result) { printf "ERROR: %s\n", $session->error(); $session->close(); exit 1; } # Now initiate the SNMP message exchange. snmp_dispatcher(); $session->close(); # Print the results, specifically formatting ifPhysAddress. for my $oid (oid_lex_sort(keys %table)) { if (!oid_base_match($OID_ifPhysAddress, $oid)) { printf "%s = %s\n", $oid, $table{$oid}; } else { printf "%s = %s\n", $oid, unpack 'H*', $table{$oid}; } } exit 0; sub table_callback { my ($session, $table) = @_; my $list = $session->var_bind_list(); if (!defined $list) { printf "ERROR: %s\n", $session->error(); return; } # Loop through each of the OIDs in the response and assign # the key/value pairs to the reference that was passed with # the callback. Make sure that we are still in the table # before assigning the key/values. my @names = $session->var_bind_names(); my $next = undef; while (@names) { $next = shift @names; if (!oid_base_match($OID_ifTable, $next)) { return; # Table is done. } $table->{$next} = $list->{$next}; } # Table is not done, send another request, starting at the last # OBJECT IDENTIFIER in the response. No need to include the # calback argument, the same callback that was specified for the # original request will be used. my $result = $session->get_bulk_request( -varbindlist => [ $next ], -maxrepetitions => 10, ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); } return; } =head2 4. Non-blocking SNMPv1 get-request and set-request on multiple hosts This example first polls several hosts for their sysUpTime. If the poll of the host is successful, the sysContact and sysLocation information is set on the host. The sysContact information is hardcoded to "Help Desk x911" while the sysLocation information is passed as an argument to the callback. #! /usr/local/bin/perl use strict; use warnings; use Net::SNMP; my $OID_sysUpTime = '1.3.6.1.2.1.1.3.0'; my $OID_sysContact = '1.3.6.1.2.1.1.4.0'; my $OID_sysLocation = '1.3.6.1.2.1.1.6.0'; # Hash of hosts and location data. my %host_data = ( '10.1.1.2' => 'Building 1, Second Floor', '10.2.1.1' => 'Building 2, First Floor', 'localhost' => 'Right here!', ); # Create a session for each host and queue a get-request for sysUpTime. for my $host (keys %host_data) { my ($session, $error) = Net::SNMP->session( -hostname => $host, -community => 'private', -nonblocking => 1, ); if (!defined $session) { printf "ERROR: Failed to create session for host '%s': %s.\n", $host, $error; next; } my $result = $session->get_request( -varbindlist => [ $OID_sysUpTime ], -callback => [ \&get_callback, $host_data{$host} ], ); if (!defined $result) { printf "ERROR: Failed to queue get request for host '%s': %s.\n", $session->hostname(), $session->error(); } } # Now initiate the SNMP message exchange. snmp_dispatcher(); exit 0; sub get_callback { my ($session, $location) = @_; my $result = $session->var_bind_list(); if (!defined $result) { printf "ERROR: Get request failed for host '%s': %s.\n", $session->hostname(), $session->error(); return; } printf "The sysUpTime for host '%s' is %s.\n", $session->hostname(), $result->{$OID_sysUpTime}; # Now set the sysContact and sysLocation for the host. $result = $session->set_request( -varbindlist => [ $OID_sysContact, OCTET_STRING, 'Help Desk x911', $OID_sysLocation, OCTET_STRING, $location, ], -callback => \&set_callback, ); if (!defined $result) { printf "ERROR: Failed to queue set request for host '%s': %s.\n", $session->hostname(), $session->error(); } return; } sub set_callback { my ($session) = @_; my $result = $session->var_bind_list(); if (defined $result) { printf "The sysContact for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysContact}; printf "The sysLocation for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysLocation}; } else { printf "ERROR: Set request failed for host '%s': %s.\n", $session->hostname(), $session->error(); } return; } =head1 REQUIREMENTS =over =item * The Net::SNMP module uses syntax that is not supported in versions of Perl earlier than v5.6.0. =item * The non-core modules F, F, F, and F are required to support SNMPv3. =item * In order to support the AES Cipher Algorithm as a SNMPv3 privacy protocol, the non-core module F is needed. =item * To use UDP/IPv6 or TCP/IPv6 as a Transport Domain, the non-core module F is needed. =back =head1 AUTHOR David M. Town Edtown@cpan.orgE =head1 ACKNOWLEDGMENTS The original concept for this module was based on F written by Simon Leinen Esimon@switch.chE. The Abstract Syntax Notation One (ASN.1) encode and decode methods were originally derived by example from the CMU SNMP package whose copyright follows: Copyright (c) 1988, 1989, 1991, 1992 by Carnegie Mellon University. All rights reserved. =head1 LICENSE AND COPYRIGHT Copyright (c) 1998-2010 David M. Town. 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. =cut # ============================================================================ 1; # [end Net::SNMP] Net-SNMP-v6.0.1/lib/Net/SNMP/0000755000175000017500000000000011442272645014335 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP/Security.pm0000444000175000017500000001302311442272645016477 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/PDU.pm0000444000175000017500000006440011442272645015325 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Dispatcher.pm0000444000175000017500000004373511442272645016773 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Message.pm0000444000175000017500000014520011442272645016257 0ustar dtowndtown# -*- 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 # All rights reserved. # This program is free software; you may redistribute it and/or modify it # under the same terms as the Perl 5 programming language system itself. # ============================================================================ use strict; use bytes; use Math::BigInt(); ## Version of the Net::SNMP::Message module our $VERSION = v3.0.1; ## Handle importing/exporting of symbols use base qw( Exporter ); our @EXPORT_OK = qw( TRUE FALSE DEBUG_INFO ); our %EXPORT_TAGS = ( generictrap => [ qw( COLD_START WARM_START LINK_DOWN LINK_UP AUTHENTICATION_FAILURE EGP_NEIGHBOR_LOSS ENTERPRISE_SPECIFIC ) ], msgFlags => [ qw( MSG_FLAGS_NOAUTHNOPRIV MSG_FLAGS_AUTH MSG_FLAGS_PRIV MSG_FLAGS_REPORTABLE MSG_FLAGS_MASK ) ], securityLevels => [ qw( SECURITY_LEVEL_NOAUTHNOPRIV SECURITY_LEVEL_AUTHNOPRIV SECURITY_LEVEL_AUTHPRIV ) ], securityModels => [ qw( SECURITY_MODEL_ANY SECURITY_MODEL_SNMPV1 SECURITY_MODEL_SNMPV2C SECURITY_MODEL_USM ) ], translate => [ qw( TRANSLATE_NONE TRANSLATE_OCTET_STRING TRANSLATE_NULL TRANSLATE_TIMETICKS TRANSLATE_OPAQUE TRANSLATE_NOSUCHOBJECT TRANSLATE_NOSUCHINSTANCE TRANSLATE_ENDOFMIBVIEW TRANSLATE_UNSIGNED TRANSLATE_ALL ) ], types => [ qw( INTEGER INTEGER32 OCTET_STRING NULL OBJECT_IDENTIFIER SEQUENCE IPADDRESS COUNTER COUNTER32 GAUGE GAUGE32 UNSIGNED32 TIMETICKS OPAQUE COUNTER64 NOSUCHOBJECT NOSUCHINSTANCE ENDOFMIBVIEW GET_REQUEST GET_NEXT_REQUEST GET_RESPONSE SET_REQUEST TRAP GET_BULK_REQUEST INFORM_REQUEST SNMPV2_TRAP REPORT ) ], utilities => [ qw( asn1_ticks_to_time asn1_itoa ) ], versions => [ qw( SNMP_VERSION_1 SNMP_VERSION_2C SNMP_VERSION_3 ) ], ); Exporter::export_ok_tags( qw( generictrap msgFlags securityLevels securityModels translate types utilities versions ) ); $EXPORT_TAGS{ALL} = [ @EXPORT_OK ]; ## ASN.1 Basic Encoding Rules type definitions sub INTEGER { 0x02 } # INTEGER sub INTEGER32 { 0x02 } # Integer32 - SNMPv2c sub OCTET_STRING { 0x04 } # OCTET STRING sub NULL { 0x05 } # NULL sub OBJECT_IDENTIFIER { 0x06 } # OBJECT IDENTIFIER sub SEQUENCE { 0x30 } # SEQUENCE sub IPADDRESS { 0x40 } # IpAddress sub COUNTER { 0x41 } # Counter sub COUNTER32 { 0x41 } # Counter32 - SNMPv2c sub GAUGE { 0x42 } # Gauge sub GAUGE32 { 0x42 } # Gauge32 - SNMPv2c sub UNSIGNED32 { 0x42 } # Unsigned32 - SNMPv2c sub TIMETICKS { 0x43 } # TimeTicks sub OPAQUE { 0x44 } # Opaque sub COUNTER64 { 0x46 } # Counter64 - SNMPv2c sub NOSUCHOBJECT { 0x80 } # noSuchObject - SNMPv2c sub NOSUCHINSTANCE { 0x81 } # noSuchInstance - SNMPv2c sub ENDOFMIBVIEW { 0x82 } # endOfMibView - SNMPv2c sub GET_REQUEST { 0xa0 } # GetRequest-PDU sub GET_NEXT_REQUEST { 0xa1 } # GetNextRequest-PDU sub GET_RESPONSE { 0xa2 } # GetResponse-PDU sub SET_REQUEST { 0xa3 } # SetRequest-PDU sub TRAP { 0xa4 } # Trap-PDU sub GET_BULK_REQUEST { 0xa5 } # GetBulkRequest-PDU - SNMPv2c sub INFORM_REQUEST { 0xa6 } # InformRequest-PDU - SNMPv2c sub SNMPV2_TRAP { 0xa7 } # SNMPv2-Trap-PDU - SNMPv2c sub REPORT { 0xa8 } # Report-PDU - SNMPv3 ## SNMP RFC version definitions sub SNMP_VERSION_1 { 0x00 } # RFC 1157 SNMPv1 sub SNMP_VERSION_2C { 0x01 } # RFC 1901 Community-based SNMPv2 sub SNMP_VERSION_3 { 0x03 } # RFC 3411 SNMPv3 ## RFC 1157 - generic-trap definitions sub COLD_START { 0 } # coldStart(0) sub WARM_START { 1 } # warmStart(1) sub LINK_DOWN { 2 } # linkDown(2) sub LINK_UP { 3 } # linkUp(3) sub AUTHENTICATION_FAILURE { 4 } # authenticationFailure(4) sub EGP_NEIGHBOR_LOSS { 5 } # egpNeighborLoss(5) sub ENTERPRISE_SPECIFIC { 6 } # enterpriseSpecific(6) ## RFC 3412 - msgFlags::=OCTET STRING sub MSG_FLAGS_NOAUTHNOPRIV { 0x00 } # Means noAuthNoPriv sub MSG_FLAGS_AUTH { 0x01 } # authFlag sub MSG_FLAGS_PRIV { 0x02 } # privFlag sub MSG_FLAGS_REPORTABLE { 0x04 } # reportableFlag sub MSG_FLAGS_MASK { 0x07 } ## RFC 3411 - SnmpSecurityLevel::=TEXTUAL-CONVENTION sub SECURITY_LEVEL_NOAUTHNOPRIV { 1 } # noAuthNoPriv sub SECURITY_LEVEL_AUTHNOPRIV { 2 } # authNoPriv sub SECURITY_LEVEL_AUTHPRIV { 3 } # authPriv ## RFC 3411 - SnmpSecurityModel::=TEXTUAL-CONVENTION sub SECURITY_MODEL_ANY { 0 } # Reserved for 'any' sub SECURITY_MODEL_SNMPV1 { 1 } # Reserved for SNMPv1 sub SECURITY_MODEL_SNMPV2C { 2 } # Reserved for SNMPv2c sub SECURITY_MODEL_USM { 3 } # User-Based Security Model (USM) ## Translation masks sub TRANSLATE_NONE { 0x00 } # Bit masks used to determine sub TRANSLATE_OCTET_STRING { 0x01 } # if a specific ASN.1 type is sub TRANSLATE_NULL { 0x02 } # translated into a "human sub TRANSLATE_TIMETICKS { 0x04 } # readable" form. sub TRANSLATE_OPAQUE { 0x08 } sub TRANSLATE_NOSUCHOBJECT { 0x10 } sub TRANSLATE_NOSUCHINSTANCE { 0x20 } sub TRANSLATE_ENDOFMIBVIEW { 0x40 } sub TRANSLATE_UNSIGNED { 0x80 } sub TRANSLATE_ALL { 0xff } ## Truth values sub TRUE { 0x01 } sub FALSE { 0x00 } ## Package variables our $DEBUG = FALSE; # Debug flag our $AUTOLOAD; # Used by the AUTOLOAD method ## Initialize the request-id/msgID. our $ID = int rand((2**16) - 1) + ($^T & 0xff); # [public methods] ----------------------------------------------------------- sub new { my ($class, %argv) = @_; # Create a new data structure for the object my $this = bless { '_buffer' => q{}, # Serialized message buffer '_error' => undef, # Error message '_index' => 0, # Buffer index '_leading_dot' => FALSE, # Prepend leading dot on OIDs '_length' => 0, # Buffer length '_security' => undef, # Security Model object '_translate' => TRANSLATE_NONE, # Translation mode '_transport' => undef, # Transport Layer object '_version' => SNMP_VERSION_1, # SNMP version }, $class; # Validate the passed arguments for (keys %argv) { if (/^-?callback$/i) { $this->callback($argv{$_}); } elsif (/^-?debug$/i) { $this->debug($argv{$_}); } elsif (/^-?leadingdot$/i) { $this->leading_dot($argv{$_}); } elsif (/^-?msgid$/i) { $this->msg_id($argv{$_}); } elsif (/^-?requestid$/i) { $this->request_id($argv{$_}); } elsif (/^-?security$/i) { $this->security($argv{$_}); } elsif (/^-?translate$/i) { $this->translate($argv{$_}); } elsif (/^-?transport$/i) { $this->transport($argv{$_}); } elsif (/^-?version$/i) { $this->version($argv{$_}); } else { $this->_error('The argument "%s" is unknown', $_); } if (defined $this->{_error}) { return wantarray ? (undef, $this->{_error}) : undef; } } return wantarray ? ($this, q{}) : $this; } { my $prepare_methods = { INTEGER, \&_prepare_integer, OCTET_STRING, \&_prepare_octet_string, NULL, \&_prepare_null, OBJECT_IDENTIFIER, \&_prepare_object_identifier, SEQUENCE, \&_prepare_sequence, IPADDRESS, \&_prepare_ipaddress, COUNTER, \&_prepare_counter, GAUGE, \&_prepare_gauge, TIMETICKS, \&_prepare_timeticks, OPAQUE, \&_prepare_opaque, COUNTER64, \&_prepare_counter64, NOSUCHOBJECT, \&_prepare_nosuchobject, NOSUCHINSTANCE, \&_prepare_nosuchinstance, ENDOFMIBVIEW, \&_prepare_endofmibview, GET_REQUEST, \&_prepare_get_request, GET_NEXT_REQUEST, \&_prepare_get_next_request, GET_RESPONSE, \&_prepare_get_response, SET_REQUEST, \&_prepare_set_request, TRAP, \&_prepare_trap, GET_BULK_REQUEST, \&_prepare_get_bulk_request, INFORM_REQUEST, \&_prepare_inform_request, SNMPV2_TRAP, \&_prepare_v2_trap, REPORT, \&_prepare_report }; sub prepare { # my ($this, $type, $value) = @_; return $_[0]->_error() if defined $_[0]->{_error}; if (!defined $_[1]) { return $_[0]->_error('The ASN.1 type is not defined'); } if (!exists $prepare_methods->{$_[1]}) { return $_[0]->_error('The ASN.1 type "%s" is unknown', $_[1]); } return $_[0]->${\$prepare_methods->{$_[1]}}($_[2]); } } { my $process_methods = { INTEGER, \&_process_integer32, OCTET_STRING, \&_process_octet_string, NULL, \&_process_null, OBJECT_IDENTIFIER, \&_process_object_identifier, SEQUENCE, \&_process_sequence, IPADDRESS, \&_process_ipaddress, COUNTER, \&_process_counter, GAUGE, \&_process_gauge, TIMETICKS, \&_process_timeticks, OPAQUE, \&_process_opaque, COUNTER64, \&_process_counter64, NOSUCHOBJECT, \&_process_nosuchobject, NOSUCHINSTANCE, \&_process_nosuchinstance, ENDOFMIBVIEW, \&_process_endofmibview, GET_REQUEST, \&_process_get_request, GET_NEXT_REQUEST, \&_process_get_next_request, GET_RESPONSE, \&_process_get_response, SET_REQUEST, \&_process_set_request, TRAP, \&_process_trap, GET_BULK_REQUEST, \&_process_get_bulk_request, INFORM_REQUEST, \&_process_inform_request, SNMPV2_TRAP, \&_process_v2_trap, REPORT, \&_process_report }; sub process { # my ($this, $expected, $found) = @_; # XXX: If present, $found is updated as a side effect. return $_[0]->_error() if defined $_[0]->{_error}; return $_[0]->_error() if !defined (my $type = $_[0]->_buffer_get(1)); $type = unpack 'C', $type; if (!exists $process_methods->{$type}) { return $_[0]->_error('The ASN.1 type 0x%02x is unknown', $type); } # Check to see if a specific ASN.1 type was expected. if ((@_ > 1) && (defined $_[1]) && ($type != $_[1])) { return $_[0]->_error( 'Expected %s, but found %s', asn1_itoa($_[1]), asn1_itoa($type) ); } # Update the found ASN.1 type, if the argument is present. if (@_ == 3) { $_[2] = $type; } return $_[0]->${\$process_methods->{$type}}($type); } } sub context_engine_id { my ($this, $engine_id) = @_; # RFC 3412 - contextEngineID::=OCTET STRING if (@_ == 2) { if (!defined $engine_id) { return $this->_error('The contextEngineID value is not defined'); } $this->{_context_engine_id} = $engine_id; } if (exists $this->{_context_engine_id}) { return $this->{_context_engine_id} || q{}; } elsif (defined $this->{_security}) { return $this->{_security}->engine_id() || q{}; } return q{}; } sub context_name { my ($this, $name) = @_; # RFC 3412 - contextName::=OCTET STRING if (@_ == 2) { if (!defined $name) { return $this->_error('The contextName value is not defined'); } $this->{_context_name} = $name; } return exists($this->{_context_name}) ? $this->{_context_name} : q{}; } sub msg_flags { my ($this, $flags) = @_; # RFC 3412 - msgFlags::=OCTET STRING (SIZE(1)) # NOTE: The stored value is not an OCTET STRING. if (@_ == 2) { if (!defined $flags) { return $this->_error('The msgFlags value is not defined'); } $this->{_msg_flags} = $flags; } if (exists $this->{_msg_flags}) { return $this->{_msg_flags}; } return MSG_FLAGS_NOAUTHNOPRIV; } sub msg_id { my ($this, $msg_id) = @_; # RFC 3412 - msgID::=INTEGER (0..2147483647) if (@_ == 2) { if (!defined $msg_id) { return $this->_error('The msgID value is not defined'); } if (($msg_id < 0) || ($msg_id > 2147483647)) { return $this->_error( 'The msgId %d is out of range (0..2147483647)', $msg_id ); } $this->{_msg_id} = $msg_id; } if (exists $this->{_msg_id}) { return $this->{_msg_id}; } elsif (exists $this->{_request_id}) { return $this->{_request_id}; } return 0; } sub msg_max_size { my ($this, $size) = @_; # RFC 3412 - msgMaxSize::=INTEGER (484..2147483647) if (@_ == 2) { if (!defined $size) { return $this->_error('The msgMaxSize value is not defined'); } if (($size < 484) || ($size > 2147483647)) { return $this->_error( 'The msgMaxSize %d is out of range (484..2147483647)', $size ); } $this->{_msg_max_size} = $size; } return $this->{_msg_max_size} || 484; } sub msg_security_model { my ($this, $model) = @_; # RFC 3412 - msgSecurityModel::=INTEGER (1..2147483647) if (@_ == 2) { if (!defined $model) { return $this->_error('The msgSecurityModel value is not defined'); } if (($model < 1) || ($model > 2147483647)) { return $this->_error( 'The msgSecurityModel %d is out of range (1..2147483647)', $model ); } $this->{_security_model} = $model; } if (exists $this->{_security_model}) { return $this->{_security_model}; } elsif (defined $this->{_security}) { return $this->{_security}->security_model(); } else { if ($this->{_version} == SNMP_VERSION_1) { return SECURITY_MODEL_SNMPV1; } elsif ($this->{_version} == SNMP_VERSION_2C) { return SECURITY_MODEL_SNMPV2C; } elsif ($this->{_version} == SNMP_VERSION_3) { return SECURITY_MODEL_USM; } } return SECURITY_MODEL_ANY; } sub request_id { my ($this, $request_id) = @_; # request-id::=INTEGER if (@_ == 2) { if (!defined $request_id) { return $this->_error('The request-id value is not defined'); } $this->{_request_id} = $request_id; } return exists($this->{_request_id}) ? $this->{_request_id} : 0; } sub security_level { my ($this, $level) = @_; # RFC 3411 - SnmpSecurityLevel::=INTEGER { noAuthNoPriv(1), # authNoPriv(2), # authPriv(3) } if (@_ == 2) { if (!defined $level) { return $this->_error('The securityLevel value is not defined'); } if (($level < SECURITY_LEVEL_NOAUTHNOPRIV) || ($level > SECURITY_LEVEL_AUTHPRIV)) { return $this->_error( 'The securityLevel %d is out of range (%d..%d)', $level, SECURITY_LEVEL_NOAUTHNOPRIV, SECURITY_LEVEL_AUTHPRIV ); } $this->{_security_level} = $level; } if (exists $this->{_security_level}) { return $this->{_security_level}; } elsif (defined $this->{_security}) { return $this->{_security}->security_level(); } return SECURITY_LEVEL_NOAUTHNOPRIV; } sub security_name { my ($this, $name) = @_; if (@_ == 2) { if (!defined $name) { return $this->_error('The securityName value is not defined'); } # No length checks due to no limits by RFC 1157 for community name. $this->{_security_name} = $name; } if (exists $this->{_security_name}) { return $this->{_security_name}; } elsif (defined $this->{_security}) { return $this->{_security}->security_name(); } return q{}; } sub version { my ($this, $version) = @_; if (@_ == 2) { if (($version == SNMP_VERSION_1) || ($version == SNMP_VERSION_2C) || ($version == SNMP_VERSION_3)) { $this->{_version} = $version; } else { return $this->_error('The SNMP version %d is not supported', $version); } } return $this->{_version}; } sub error_status { return 0; # noError(0) } sub error_index { return 0; } sub var_bind_list { return undef; } sub var_bind_names { return []; } sub var_bind_types { return undef; } # # Security Model accessor methods # sub security { my ($this, $security) = @_; if (@_ == 2) { if (defined $security) { $this->{_security} = $security; } else { $this->_error_clear(); return $this->_error('The Security Model object is not defined'); } } return $this->{_security}; } # # Transport Domain accessor methods # sub transport { my ($this, $transport) = @_; if (@_ == 2) { if (defined $transport) { $this->{_transport} = $transport; } else { $this->_error_clear(); return $this->_error('The Transport Domain object is not defined'); } } return $this->{_transport}; } sub hostname { my ($this) = @_; if (defined $this->{_transport}) { return $this->{_transport}->dest_hostname(); } return q{}; } sub dstname { require Carp; Carp::croak( sprintf '%s::dstname() is obsolete, use hostname() instead', ref $_[0] ); # Never get here. return shift->hostname(@_); } sub max_msg_size { my ($this, $size) = @_; if (!defined $this->{_transport}) { return 0; } if (@_ == 2) { $this->_error_clear(); if (defined ($size = $this->{_transport}->max_msg_size($size))) { return $size; } return $this->_error($this->{_transport}->error()); } return $this->{_transport}->max_msg_size(); } sub retries { return defined($_[0]->{_transport}) ? $_[0]->{_transport}->retries() : 0; } sub timeout { return defined($_[0]->{_transport}) ? $_[0]->{_transport}->timeout() : 0; } sub send { my ($this) = @_; $this->_error_clear(); if (!defined $this->{_transport}) { return $this->_error('The Transport Domain object is not defined'); } DEBUG_INFO('transport address %s', $this->{_transport}->dest_taddress()); $this->_buffer_dump(); if (defined (my $bytes = $this->{_transport}->send($this->{_buffer}))) { return $bytes; } return $this->_error($this->{_transport}->error()); } sub recv { my ($this) = @_; $this->_error_clear(); if (!defined $this->{_transport}) { return $this->_error('The Transport Domain object is not defined'); } my $name = $this->{_transport}->recv($this->{_buffer}); if (defined $name) { $this->{_length} = CORE::length($this->{_buffer}); DEBUG_INFO('transport address %s', $this->{_transport}->peer_taddress()); $this->_buffer_dump(); return $name; } return $this->_error($this->{_transport}->error()); } # # Data representation methods # sub translate { return (@_ == 2) ? $_[0]->{_translate} = $_[1] : $_[0]->{_translate}; } sub leading_dot { return (@_ == 2) ? $_[0]->{_leading_dot} = $_[1] : $_[0]->{_leading_dot}; } # # Callback handler methods # sub callback { my ($this, $callback) = @_; if (@_ == 2) { if (ref($callback) eq 'CODE') { $this->{_callback} = $callback; } elsif (!defined $callback) { $this->{_callback} = undef; } else { DEBUG_INFO('unexpected callback format'); } } return $this->{_callback}; } sub callback_execute { my ($this) = @_; if (!defined $this->{_callback}) { DEBUG_INFO('no callback'); return TRUE; } # Protect ourselves from user error. eval { $this->{_callback}->($this); }; # We clear the callback in case it was a closure which might hold # up the reference count of the calling object. $this->{_callback} = undef; return ($@) ? $this->_error($@) : TRUE; } sub status_information { my $this = shift; if (@_) { $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0]; if ($this->debug()) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $this->{_error}; } $this->callback_execute(); } return $this->{_error} || q{}; } sub process_response_pdu { goto &callback_execute; } sub timeout_id { return (@_ == 2) ? $_[0]->{_timeout_id} = $_[1] : $_[0]->{_timeout_id}; } # # Buffer manipulation methods # sub index { my ($this, $index) = @_; if ((@_ == 2) && ($index >= 0) && ($index <= $this->{_length})) { $this->{_index} = $index; } return $this->{_index}; } sub length { return $_[0]->{_length}; } sub prepend { goto &_buffer_put; } sub append { goto &_buffer_append; } sub copy { return $_[0]->{_buffer}; } sub reference { return \$_[0]->{_buffer}; } sub clear { my ($this) = @_; $this->{_index} = 0; $this->{_length} = 0; return substr $this->{_buffer}, 0, CORE::length($this->{_buffer}), q{}; } sub dump { goto &_buffer_dump; } # # Debug/error handling methods # sub error { my $this = shift; if (@_) { if (defined $_[0]) { $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0]; if ($this->debug()) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $this->{_error}; } } else { $this->{_error} = undef; } } return $this->{_error} || q{}; } sub debug { return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG; } sub AUTOLOAD { my ($this) = @_; return if $AUTOLOAD =~ /::DESTROY$/; $AUTOLOAD =~ s/.*://; if (ref $this) { $this->_error_clear(); return $this->_error('The method "%s" is not supported', $AUTOLOAD); } else { require Carp; Carp::croak(sprintf 'The function "%s" is not supported', $AUTOLOAD); } # Never get here. return; } # [private methods] ---------------------------------------------------------- # # Basic Encoding Rules (BER) prepare methods # sub _prepare_type_length { # my ($this, $type, $value) = @_; if (!defined $_[1]) { return $_[0]->_error('The ASN.1 type is not defined'); } my $length = CORE::length($_[2]); if ($length < 0x80) { return $_[0]->_buffer_put(pack('C2', $_[1], $length) . $_[2]); } elsif ($length <= 0xff) { return $_[0]->_buffer_put(pack('C3', $_[1], 0x81, $length) . $_[2]); } elsif ($length <= 0xffff) { return $_[0]->_buffer_put(pack('CCn', $_[1], 0x82, $length) . $_[2]); } return $_[0]->_error('Unable to prepare the ASN.1 length'); } sub _prepare_integer { my ($this, $value) = @_; if (!defined $value) { return $this->_error('The INTEGER value is not defined'); } if ($value !~ /^-?\d+$/) { return $this->_error( 'The INTEGER value "%s" is expected in numeric format', $value ); } if ($value < -2147483648 || $value > 4294967295) { return $this->_error( 'The INTEGER value "%s" is out of range (-2147483648..4294967295)', $value ); } return $this->_prepare_integer32(INTEGER, $value); } sub _prepare_unsigned32 { my ($this, $type, $value) = @_; if (!defined $value) { return $this->_error('The %s value is not defined', asn1_itoa($type)); } if ($value !~ /^\d+$/) { return $this->_error( 'The %s value "%s" is expected in positive numeric format', asn1_itoa($type), $value ); } if ($value < 0 || $value > 4294967295) { return $this->_error( 'The %s value "%s" is out of range (0..4294967295)', asn1_itoa($type), $value ); } return $this->_prepare_integer32($type, $value); } sub _prepare_integer32 { my ($this, $type, $value) = @_; # Determine if the value is positive or negative my $negative = ($value < 0); # Check to see if the most significant bit is set, if it is we # need to prefix the encoding with a zero byte. my $size = 4; # Assuming 4 byte integers my $prefix = FALSE; my $bytes = q{}; if ((($value & 0xff000000) & 0x80000000) && (!$negative)) { $size++; $prefix = TRUE; } # Remove occurances of nine consecutive ones (if negative) or zeros # from the most significant end of the two's complement integer. while ((((!($value & 0xff800000))) || ((($value & 0xff800000) == 0xff800000) && ($negative))) && ($size > 1)) { $size--; $value <<= 8; } # Add a zero byte so the integer is decoded as a positive value if ($prefix) { $bytes = pack 'x'; $size--; } # Build the integer while ($size-- > 0) { $bytes .= pack 'C*', (($value & 0xff000000) >> 24); $value <<= 8; } # Encode ASN.1 header return $this->_prepare_type_length($type, $bytes); } sub _prepare_octet_string { my ($this, $value) = @_; if (!defined $value) { return $this->_error('The OCTET STRING value is not defined'); } return $this->_prepare_type_length(OCTET_STRING, $value); } sub _prepare_null { return $_[0]->_prepare_type_length(NULL, q{}); } sub _prepare_object_identifier { my ($this, $value) = @_; if (!defined $value) { return $this->_error('The OBJECT IDENTIFIER value not defined'); } # The OBJECT IDENTIFIER is expected in dotted notation. if ($value !~ m/^\.?\d+(?:\.\d+)* *$/) { return $this->_error( 'The OBJECT IDENTIFIER value "%s" is expected in dotted decimal ' . 'notation', $value ); } # Break it up into sub-identifiers. my @subids = split /\./, $value; # If there was a leading dot on _any_ OBJECT IDENTIFIER passed to # a prepare method, return a leading dot on _all_ of the OBJECT # IDENTIFIERs in the process methods. if ($subids[0] eq q{}) { DEBUG_INFO('leading dot present'); $this->{_leading_dot} = TRUE; shift @subids; } # RFC 2578 Section 3.5 - "...there are at most 128 sub-identifiers in # a value, and each sub-identifier has a maximum value of 2^32-1..." if (@subids > 128) { return $this->_error( 'The OBJECT IDENTIFIER value "%s" contains more than the maximum ' . 'of 128 sub-identifiers allowed', $value ); } if (grep { $_ < 0 || $_ > 4294967295; } @subids) { return $this->_error( 'The OBJECT IDENTIFIER value "%s" contains a sub-identifier which ' . 'is out of range (0..4294967295)', $value ); } # ISO/IEC 8825 - Specification of Basic Encoding Rules for Abstract # Syntax Notation One (ASN.1) dictates that the first two sub-identifiers # are encoded into the first identifier using the the equation: # subid = ((first * 40) + second). Pad the OBJECT IDENTIFIER to at # least two sub-identifiers. while (@subids < 2) { push @subids, 0; } # The first sub-identifiers are limited to ccitt(0), iso(1), and # joint-iso-ccitt(2) as defined by RFC 2578. if ($subids[0] > 2) { return $this->_error( 'The OBJECT IDENTIFIER value "%s" must begin with either 0 ' . '(ccitt), 1 (iso), or 2 (joint-iso-ccitt)', $value ); } # If the first sub-identifier is 0 or 1, the second is limited to 0 - 39. if (($subids[0] < 2) && ($subids[1] >= 40)) { return $this->_error( 'The second sub-identifier in the OBJECT IDENTIFIER value "%s" ' . 'must be less than 40', $value ); } elsif ($subids[1] >= (4294967295 - 80)) { return $this->_error( 'The second sub-identifier in the OBJECT IDENTIFIER value "%s" ' . 'must be less than %u', $value, (4294967295 - 80) ); } # Now apply: subid = ((first * 40) + second) $subids[1] += (shift(@subids) * 40); # Encode each sub-identifier in base 128, most significant digit first, # with as few digits as possible. Bit eight (the high bit) is set on # each byte except the last. # Encode the ASN.1 header return $this->_prepare_type_length(OBJECT_IDENTIFIER, pack 'w*', @subids); } sub _prepare_sequence { return $_[0]->_prepare_implicit_sequence(SEQUENCE, $_[1]); } sub _prepare_implicit_sequence { my ($this, $type, $value) = @_; if (defined $value) { return $this->_prepare_type_length($type, $value); } # If the passed value is undefined, we assume that the value of # the IMPLICIT SEQUENCE is the data currently in the serial buffer. if ($this->{_length} < 0x80) { return $this->_buffer_put(pack 'C2', $type, $this->{_length}); } elsif ($this->{_length} <= 0xff) { return $this->_buffer_put(pack 'C3', $type, 0x81, $this->{_length}); } elsif ($this->{_length} <= 0xffff) { return $this->_buffer_put(pack 'CCn', $type, 0x82, $this->{_length}); } return $this->_error('Unable to prepare the ASN.1 SEQUENCE length'); } sub _prepare_ipaddress { my ($this, $value) = @_; if (!defined $value) { return $this->_error('IpAddress is not defined'); } if ($value !~ /^\d+\.\d+\.\d+\.\d+$/) { return $this->_error( 'The IpAddress value "%s" is expected in dotted decimal notation', $value ); } my @octets = split /\./, $value; if (grep { $_ > 255; } @octets) { return $this->_error('The IpAddress value "%s" is invalid', $value); } return $this->_prepare_type_length(IPADDRESS, pack 'C4', @octets); } sub _prepare_counter { return $_[0]->_prepare_unsigned32(COUNTER, $_[1]); } sub _prepare_gauge { return $_[0]->_prepare_unsigned32(GAUGE, $_[1]); } sub _prepare_timeticks { return $_[0]->_prepare_unsigned32(TIMETICKS, $_[1]); } sub _prepare_opaque { my ($this, $value) = @_; if (!defined $value) { return $this->_error('The Opaque value is not defined'); } return $this->_prepare_type_length(OPAQUE, $value); } sub _prepare_counter64 { my ($this, $value) = @_; # Validate the SNMP version if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The Counter64 type is not supported in SNMPv1'); } # Validate the passed value if (!defined $value) { return $this->_error('The Counter64 value is not defined'); } if ($value !~ /^\+?\d+$/) { return $this->_error( 'The Counter64 value "%s" is expected in positive numeric format', $value ); } $value = Math::BigInt->new($value); if ($value eq 'NaN') { return $this->_error('The Counter64 value "%s" is invalid', $value); } # Make sure the value is no more than 8 bytes long if ($value->bcmp('18446744073709551615') > 0) { return $this->_error( 'The Counter64 value "%s" is out of range (0..18446744073709551615)', $value ); } my ($quotient, $remainder, @bytes); # Handle a value of zero if ($value == 0) { unshift @bytes, 0x00; } while ($value > 0) { ($quotient, $remainder) = $value->bdiv(256); $value = Math::BigInt->new($quotient); unshift @bytes, $remainder; } # Make sure that the value is encoded as a positive value if ($bytes[0] & 0x80) { unshift @bytes, 0x00; } return $this->_prepare_type_length(COUNTER64, pack 'C*', @bytes); } sub _prepare_nosuchobject { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The noSuchObject type is not supported in SNMPv1'); } return $this->_prepare_type_length(NOSUCHOBJECT, q{}); } sub _prepare_nosuchinstance { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error( 'The noSuchInstance type is not supported in SNMPv1' ); } return $this->_prepare_type_length(NOSUCHINSTANCE, q{}); } sub _prepare_endofmibview { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The endOfMibView type is not supported in SNMPv1'); } return $this->_prepare_type_length(ENDOFMIBVIEW, q{}); } sub _prepare_get_request { return $_[0]->_prepare_implicit_sequence(GET_REQUEST, $_[1]); } sub _prepare_get_next_request { return $_[0]->_prepare_implicit_sequence(GET_NEXT_REQUEST, $_[1]); } sub _prepare_get_response { return $_[0]->_prepare_implicit_sequence(GET_RESPONSE, $_[1]); } sub _prepare_set_request { return $_[0]->_prepare_implicit_sequence(SET_REQUEST, $_[1]); } sub _prepare_trap { my ($this, $value) = @_; if ($this->{_version} != SNMP_VERSION_1) { return $this->_error('The Trap-PDU is only supported in SNMPv1'); } return $this->_prepare_implicit_sequence(TRAP, $value); } sub _prepare_get_bulk_request { my ($this, $value) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error( 'The GetBulkRequest-PDU is not supported in SNMPv1' ); } return $this->_prepare_implicit_sequence(GET_BULK_REQUEST, $value); } sub _prepare_inform_request { my ($this, $value) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The InformRequest-PDU is not supported in SNMPv1'); } return $this->_prepare_implicit_sequence(INFORM_REQUEST, $value); } sub _prepare_v2_trap { my ($this, $value) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The SNMPv2-Trap-PDU is not supported in SNMPv1'); } return $this->_prepare_implicit_sequence(SNMPV2_TRAP, $value); } sub _prepare_report { my ($this, $value) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The Report-PDU is not supported in SNMPv1'); } return $this->_prepare_implicit_sequence(REPORT, $value); } # # Basic Encoding Rules (BER) process methods # sub _process_length { my ($this) = @_; return $this->_error() if defined $this->{_error}; my $length = $this->_buffer_get(1); if (!defined $length) { return $this->_error(); } $length = unpack 'C', $length; if (!($length & 0x80)) { # "Short" length return $length; } my $byte_cnt = $length & 0x7f; if ($byte_cnt == 0) { return $this->_error('Indefinite ASN.1 lengths are not supported'); } elsif ($byte_cnt > 4) { return $this->_error( 'The ASN.1 length is too long (%u bytes)', $byte_cnt ); } if (!defined($length = $this->_buffer_get($byte_cnt))) { return $this->_error(); } return unpack 'N', ("\000" x (4 - $byte_cnt) . $length); } sub _process_integer32 { my ($this, $type) = @_; # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); # Return an error if the object length is zero? if ($length < 1) { return $this->_error('The %s length is equal to zero', asn1_itoa($type)); } # Retrieve the whole byte stream outside of the loop. return $this->_error() if !defined(my $bytes = $this->_buffer_get($length)); my @bytes = unpack 'C*', $bytes; my $negative = FALSE; my $int32 = 0; # Validate the length of the Integer32 if (($length > 5) || (($length > 4) && ($bytes[0] != 0x00))) { return $this->_error( 'The %s length is too long (%u bytes)', asn1_itoa($type), $length ); } # If the first bit is set, the Integer32 is negative if ($bytes[0] & 0x80) { $int32 = -1; $negative = TRUE; } # Build the Integer32 map { $int32 = (($int32 << 8) | $_) } @bytes; if ($negative) { if (($type == INTEGER) || (!($this->{_translate} & TRANSLATE_UNSIGNED))) { return unpack 'l', pack 'l', $int32; } else { DEBUG_INFO('translating negative %s value', asn1_itoa($type)); return unpack 'L', pack 'l', $int32; } } return unpack 'L', pack 'L', $int32; } sub _process_octet_string { my ($this, $type) = @_; # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); # Get the string return $this->_error() if !defined(my $s = $this->_buffer_get($length)); # Set the translation mask my $mask = ($type == OPAQUE) ? TRANSLATE_OPAQUE : TRANSLATE_OCTET_STRING; # # Translate based on the definition of a DisplayString in RFC 2579. # # DisplayString ::= TEXTUAL-CONVENTION # # - the graphics characters (32-126) are interpreted as # US ASCII # - NUL, LF, CR, BEL, BS, HT, VT and FF have the special # meanings specified in RFC 854 # - the sequence 'CR x' for any x other than LF or NUL is # illegal. # if ($this->{_translate} & $mask) { $type = asn1_itoa($type); if ($s =~ m{ # The values other than NUL, LF, CR, BEL, BS, HT, VT, FF, # and the graphic characters (32-126) trigger translation. [\x01-\x06\x0e-\x1f\x7f-\xff]| # The sequence 'CR x' for any x other than LF or NUL # also triggers translation. \x0d(?![\x00\x0a]) }x) { DEBUG_INFO( 'translating %s to hexadecimal formatted DisplayString', $type ); return sprintf '0x%s', unpack 'H*', $s; } else { DEBUG_INFO( 'not translating %s, all octets are allowed in a DisplayString', $type ); } } return $s; } sub _process_null { my ($this) = @_; # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); return $this->_error('NULL length is not equal to zero') if ($length != 0); if ($this->{_translate} & TRANSLATE_NULL) { DEBUG_INFO(q{translating NULL to 'NULL' string}); return 'NULL'; } return q{}; } sub _process_object_identifier { my ($this) = @_; # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); # Return an error if the length is equal to zero? if ($length < 1) { return $this->_error('The OBJECT IDENTIFIER length is equal to zero'); } # Retrieve the whole byte stream (by Niilo Neuvo). return $this->_error() if !defined(my $bytes = $this->_buffer_get($length)); my @oid = ( 0, eval { unpack 'w129', $bytes } ); # RFC 2578 Section 3.5 - "...there are at most 128 sub-identifiers in # a value, and each sub-identifier has a maximum value of 2^32-1..." if ($@ || (grep { $_ > 4294967295; } @oid)) { return $this->_error( 'The OBJECT IDENTIFIER contains a sub-identifier which is out of ' . 'range (0..4294967295)' ); } if (@oid > 128) { return $this->_error( 'The OBJECT IDENTIFIER contains more than the maximum of 128 ' . 'sub-identifiers allowed' ); } # The first two sub-identifiers are encoded into the first identifier # using the the equation: subid = ((first * 40) + second). if ($oid[1] == 0x2b) { # Handle the most common case $oid[0] = 1; # first [iso(1).org(3)] $oid[1] = 3; } elsif ($oid[1] < 40) { $oid[0] = 0; } elsif ($oid[1] < 80) { $oid[0] = 1; $oid[1] -= 40; } else { $oid[0] = 2; $oid[1] -= 80; } # Return the OID in dotted notation (optionally with a # leading dot if one was passed to the prepare routine). if ($this->{_leading_dot}) { DEBUG_INFO('adding leading dot'); unshift @oid, q{}; } return join q{.}, @oid; } sub _process_sequence { # Return the length, instead of the value goto &_process_length; } sub _process_ipaddress { my ($this) = @_; # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); if ($length != 4) { return $this->_error('The IpAddress length of %d is invalid', $length); } if (defined(my $ipaddress = $this->_buffer_get(4))) { return sprintf '%vd', $ipaddress; } return $this->_error(); } sub _process_counter { goto &_process_integer32; } sub _process_gauge { goto &_process_integer32; } sub _process_timeticks { my ($this) = @_; if (defined(my $ticks = $this->_process_integer32(TIMETICKS))) { if ($this->{_translate} & TRANSLATE_TIMETICKS) { DEBUG_INFO('translating %u TimeTicks to time', $ticks); return asn1_ticks_to_time($ticks); } else { return $ticks; } } return $this->_error(); } sub _process_opaque { goto &_process_octet_string; } sub _process_counter64 { my ($this, $type) = @_; # Verify the SNMP version if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The Counter64 type is not supported in SNMPv1'); } # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); # Return an error if the object length is zero? if ($length < 1) { return $this->_error('The Counter64 length is equal to zero'); } # Retrieve the whole byte stream outside of the loop. return $this->_error() if !defined(my $bytes = $this->_buffer_get($length)); my @bytes = unpack 'C*', $bytes; my $negative = FALSE; # Validate the length of the Counter64 if (($length > 9) || (($length > 8) && ($bytes[0] != 0x00))) { return $_[0]->_error( 'The Counter64 length is too long (%u bytes)', $length ); } # If the first bit is set, the integer is negative if ($bytes[0] & 0x80) { $bytes[0] ^= 0xff; $negative = TRUE; } # Build the Counter64 my $int64 = Math::BigInt->new(shift @bytes); map { if ($negative) { $_ ^= 0xff; } $int64 *= 256; $int64 += $_; } @bytes; # If the value is negative the other end incorrectly encoded # the Counter64 since it should always be a positive value. if ($negative) { $int64 = Math::BigInt->new('-1') - $int64; if ($this->{_translate} & TRANSLATE_UNSIGNED) { DEBUG_INFO('translating negative Counter64 value'); $int64 += Math::BigInt->new('18446744073709551616'); } } # Perl 5.6.0 (force to string or substitution does not work). $int64 .= q{}; # Remove the plus sign (or should we leave it to imply Math::BigInt?) $int64 =~ s/^\+//; return $int64; } sub _process_nosuchobject { my ($this) = @_; # Verify the SNMP version if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The noSuchObject type is not supported in SNMPv1'); } # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); if ($length != 0) { return $this->_error('The noSuchObject length is not equal to zero'); } if ($this->{_translate} & TRANSLATE_NOSUCHOBJECT) { DEBUG_INFO(q{translating noSuchObject to 'noSuchObject' string}); return 'noSuchObject'; } # XXX: Releases greater than v5.2.0 longer set the error-status. # $this->{_error_status} = NOSUCHOBJECT; return q{}; } sub _process_nosuchinstance { my ($this) = @_; # Verify the SNMP version if ($this->{_version} == SNMP_VERSION_1) { return $this->_error( 'The noSuchInstance type is not supported in SNMPv1' ); } # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); if ($length != 0) { return $this->_error('The noSuchInstance length is not equal to zero'); } if ($this->{_translate} & TRANSLATE_NOSUCHINSTANCE) { DEBUG_INFO(q{translating noSuchInstance to 'noSuchInstance' string}); return 'noSuchInstance'; } # XXX: Releases greater than v5.2.0 longer set the error-status. # $this->{_error_status} = NOSUCHINSTANCE; return q{}; } sub _process_endofmibview { my ($this) = @_; # Verify the SNMP version if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The endOfMibView type is not supported in SNMPv1'); } # Decode the length return $this->_error() if !defined(my $length = $this->_process_length()); if ($length != 0) { return $this->_error('The endOfMibView length is not equal to zero'); } if ($this->{_translate} & TRANSLATE_ENDOFMIBVIEW) { DEBUG_INFO(q{translating endOfMibView to 'endOfMibView' string}); return 'endOfMibView'; } # XXX: Releases greater than v5.2.0 longer set the error-status. # $this->{_error_status} = ENDOFMIBVIEW; return q{}; } sub _process_pdu_type { my ($this, $type) = @_; # Generic methods used to process the PDU type. The ASN.1 type is # returned by the method as passed by the generic process routine. return defined($this->_process_length()) ? $type : $this->_error(); } sub _process_get_request { goto &_process_pdu_type; } sub _process_get_next_request { goto &_process_pdu_type; } sub _process_get_response { goto &_process_pdu_type; } sub _process_set_request { goto &_process_pdu_type; } sub _process_trap { my ($this) = @_; if ($this->{_version} != SNMP_VERSION_1) { return $this->_error('The Trap-PDU is only supported in SNMPv1'); } goto &_process_pdu_type; } sub _process_get_bulk_request { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The GetBulkRequest-PDU is not supported in SNMPv1'); } goto &_process_pdu_type; } sub _process_inform_request { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The InformRequest-PDU is not supported in SNMPv1'); } goto &_process_pdu_type; } sub _process_v2_trap { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The SNMPv2-Trap-PDU is not supported in SNMPv1'); } goto &_process_pdu_type; } sub _process_report { my ($this) = @_; if ($this->{_version} == SNMP_VERSION_1) { return $this->_error('The Report-PDU is not supported in SNMPv1'); } goto &_process_pdu_type; } # # Abstract Syntax Notation One (ASN.1) utility functions # { my $types = { INTEGER, 'INTEGER', OCTET_STRING, 'OCTET STRING', NULL, 'NULL', OBJECT_IDENTIFIER, 'OBJECT IDENTIFIER', SEQUENCE, 'SEQUENCE', IPADDRESS, 'IpAddress', COUNTER, 'Counter', GAUGE, 'Gauge', TIMETICKS, 'TimeTicks', OPAQUE, 'Opaque', COUNTER64, 'Counter64', NOSUCHOBJECT, 'noSuchObject', NOSUCHINSTANCE, 'noSuchInstance', ENDOFMIBVIEW, 'endOfMibView', GET_REQUEST, 'GetRequest-PDU', GET_NEXT_REQUEST, 'GetNextRequest-PDU', GET_RESPONSE, 'GetResponse-PDU', SET_REQUEST, 'SetRequest-PDU', TRAP, 'Trap-PDU', GET_BULK_REQUEST, 'GetBulkRequest-PDU', INFORM_REQUEST, 'InformRequest-PDU', SNMPV2_TRAP, 'SNMPv2-Trap-PDU', REPORT, 'Report-PDU' }; sub asn1_itoa { my ($type) = @_; return q{??} if (@_ != 1); if (!exists $types->{$type}) { return sprintf '?? [0x%02x]', $type; } return $types->{$type}; } } sub asn1_ticks_to_time { my $ticks = shift || 0; my $days = int($ticks / (24 * 60 * 60 * 100)); $ticks %= (24 * 60 * 60 * 100); my $hours = int($ticks / (60 * 60 * 100)); $ticks %= (60 * 60 * 100); my $minutes = int($ticks / (60 * 100)); $ticks %= (60 * 100); my $seconds = ($ticks / 100); if ($days != 0){ return sprintf '%d day%s, %02d:%02d:%05.02f', $days, ($days == 1 ? q{} : 's'), $hours, $minutes, $seconds; } elsif ($hours != 0) { return sprintf '%d hour%s, %02d:%05.02f', $hours, ($hours == 1 ? q{} : 's'), $minutes, $seconds; } elsif ($minutes != 0) { return sprintf '%d minute%s, %05.02f', $minutes, ($minutes == 1 ? q{} : 's'), $seconds; } else { return sprintf '%04.02f second%s', $seconds, ($seconds == 1 ? q{} : 's'); } } # # Error handlers # sub _error { my $this = shift; if (!defined $this->{_error}) { $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0]; if ($this->debug()) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $this->{_error}; } } return; } sub _error_clear { return $_[0]->{_error} = undef; } # # Buffer manipulation methods # sub _buffer_append { # my ($this, $value) = @_; return $_[0]->_error() if defined $_[0]->{_error}; # Always reset the index when the buffer is modified $_[0]->{_index} = 0; # Update our length $_[0]->{_length} += CORE::length($_[1]); # Append to the current buffer return $_[0]->{_buffer} .= $_[1]; } sub _buffer_get { my ($this, $requested) = @_; return $this->_error() if defined $this->{_error}; # Return the number of bytes requested at the current index or # clear and return the whole buffer if no argument is passed. if (@_ == 2) { if (($this->{_index} += $requested) > $this->{_length}) { $this->{_index} -= $requested; if ($this->{_length} >= $this->max_msg_size()) { return $this->_error( 'The message size exceeded the buffer maxMsgSize of %d', $this->max_msg_size() ); } return $this->_error('Unexpected end of message buffer'); } return substr $this->{_buffer}, $this->{_index} - $requested, $requested; } # Always reset the index when the buffer is modified $this->{_index} = 0; # Update our length to 0, the whole buffer is about to be cleared. $this->{_length} = 0; return substr $this->{_buffer}, 0, CORE::length($this->{_buffer}), q{}; } sub _buffer_put { # my ($this, $value) = @_; return $_[0]->_error() if defined $_[0]->{_error}; # Always reset the index when the buffer is modified $_[0]->{_index} = 0; # Update our length $_[0]->{_length} += CORE::length($_[1]); # Add the prefix to the current buffer substr $_[0]->{_buffer}, 0, 0, $_[1]; return $_[0]->{_buffer}; } sub _buffer_dump { my ($this) = @_; return $DEBUG if (!$DEBUG); DEBUG_INFO('%d byte%s', $this->{_length}, $this->{_length} != 1 ? 's' : q{}); my ($offset, $hex, $text) = (0, q{}, q{}); while ($this->{_buffer} =~ /(.{1,16})/gs) { $hex = unpack 'H*', ($text = $1); $hex .= q{ } x (32 - CORE::length($hex)); $hex = sprintf '%s %s %s %s ' x 4, unpack 'a2' x 16, $hex; $text =~ s/[\x00-\x1f\x7f-\xff]/./g; printf "[%04d] %s %s\n", $offset, uc($hex), $text; $offset += 16; } return $DEBUG; } sub DEBUG_INFO { return $DEBUG if (!$DEBUG); return printf sprintf('debug: [%d] %s(): ', (caller 0)[2], (caller 1)[3]) . ((@_ > 1) ? shift(@_) : '%s') . "\n", @_; } # ============================================================================ 1; # [end Net::SNMP::Message] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport.pm0000444000175000017500000005440311442272645016673 0ustar dtowndtown# -*- 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 # 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(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] Net-SNMP-v6.0.1/lib/Net/SNMP/MessageProcessing.pm0000444000175000017500000003231211442272645020313 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Security/0000755000175000017500000000000011442272645016144 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP/Security/Community.pm0000444000175000017500000001052711442272645020471 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Security/USM.pm0000444000175000017500000014545211442272645017157 0ustar dtowndtown# -*- 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 # 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 # 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/0000755000175000017500000000000011442272645016331 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv4/0000755000175000017500000000000011442272645017113 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv4/TCP.pm0000444000175000017500000001703011442272645020076 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv4/UDP.pm0000444000175000017500000000527511442272645020110 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv6.pm0000444000175000017500000001026111442272645017451 0ustar dtowndtown# -*- 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 # 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; #
% # Resolve the address. my @info = getaddrinfo(($_[1] = $host), q{}, PF_INET6); if (@info >= 5) { if ($host =~ s/(.*)%.*$/$1/) { #
% $_[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) { # : $_[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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv4.pm0000444000175000017500000000441311442272645017451 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv6/0000755000175000017500000000000011442272645017115 5ustar dtowndtownNet-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv6/TCP.pm0000444000175000017500000000302111442272645020073 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/lib/Net/SNMP/Transport/IPv6/UDP.pm0000444000175000017500000000302011442272645020074 0ustar dtowndtown# -*- 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 # 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] Net-SNMP-v6.0.1/examples/0000755000175000017500000000000011442272645014102 5ustar dtowndtownNet-SNMP-v6.0.1/examples/trap.pl0000444000175000017500000000461711442272645015413 0ustar dtowndtown#! //bin/env perl # ============================================================================ # $Id: trap.pl,v 6.0 2009/09/09 15:05:33 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP qw( :ALL ); my ($session, $error) = Net::SNMP->session( -hostname => $ARGV[0] || 'localhost', -community => $ARGV[1] || 'public', -port => SNMP_TRAP_PORT, # Need to use port 162 ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } ## Trap example specifying all values. my $result = $session->trap( -enterprise => '1.3.6.1.4.1', -agentaddr => '10.10.1.1', -generictrap => WARM_START, -specifictrap => 0, -timestamp => 12363000, -varbindlist => [ '1.3.6.1.2.1.1.1.0', OCTET_STRING, 'Hub', '1.3.6.1.2.1.1.5.0', OCTET_STRING, 'Closet Hub', ], ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); } else { printf "Trap-PDU sent.\n"; } ## A second trap example using mainly default values. my @varbind = ( '1.3.6.1.2.1.2.2.1.7.0', INTEGER, 1, ); $result = $session->trap(-varbindlist => \@varbind); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); } else { printf "Trap-PDU sent.\n"; } $session->close(); ## Create a new object with the version set to SNMPv2c ## to send a snmpV2-trap. ($session, $error) = Net::SNMP->session( -hostname => $ARGV[0] || 'localhost', -community => $ARGV[1] || 'public', -port => SNMP_TRAP_PORT, # Need to use port 162 -version => 'snmpv2c', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } $result = $session->snmpv2_trap( -varbindlist => [ '1.3.6.1.2.1.1.3.0', TIMETICKS, 600, '1.3.6.1.6.3.1.1.4.1.0', OBJECT_IDENTIFIER, '1.3.6.1.4.1', '1.3.6.1.2.1.1.1.0', OCTET_STRING, 'Hub', '1.3.6.1.2.1.1.5.0', OCTET_STRING, 'Closet Hub', ] ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); } else { printf "SNMPv2-Trap-PDU sent.\n"; } $session->close(); exit 0; # ============================================================================ Net-SNMP-v6.0.1/examples/table.pl0000444000175000017500000000501411442272645015524 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: table.pl,v 6.0 2009/09/09 15:05:33 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP qw( snmp_dispatcher SNMP_PORT ); # Create the SNMP session my ($session, $error) = Net::SNMP->session( -hostname => $ARGV[0] || 'localhost', -community => $ARGV[1] || 'public', -port => $ARGV[2] || SNMP_PORT, -version => 'snmpv2c', ); # Was the session created? if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } # iso.org.dod.internet.mgmt.interfaces.ifTable my $OID_ifTable = '1.3.6.1.2.1.2.2'; printf "\n== SNMPv2c blocking get_table(): %s ==\n\n", $OID_ifTable; my $result; if (defined ($result = $session->get_table(-baseoid => $OID_ifTable))) { for ($session->var_bind_names()) { printf "%s => %s\n", $_, $result->{$_}; } print "\n"; } else { printf "ERROR: %s.\n\n", $session->error(); } $session->close(); ### ## Now a non-blocking example ### printf "\n== SNMPv2c non-blocking get_table(): %s ==\n\n", $OID_ifTable; # Blocking and non-blocking objects cannot exist at the # same time. We must clear the reference to the blocking # object or the creation of the non-blocking object will # fail. $session = undef; # Create the non-blocking SNMP session ($session, $error) = Net::SNMP->session( -hostname => $ARGV[0] || 'localhost', -community => $ARGV[1] || 'public', -port => $ARGV[2] || SNMP_PORT, -nonblocking => 1, -version => 'snmpv2c', ); # Was the session created? if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } if (!defined $session->get_table(-baseoid => $OID_ifTable, -callback => \&print_results_cb)) { printf "ERROR: %s.\n", $session->error(); } # Start the event loop snmp_dispatcher(); print "\n"; exit 0; sub print_results_cb { my ($session) = @_; if (!defined $session->var_bind_list()) { printf "ERROR: %s.\n", $session->error(); } else { for ($session->var_bind_names()) { printf "%s => %s\n", $_, $session->var_bind_list()->{$_}; } } return; } # ============================================================================ Net-SNMP-v6.0.1/examples/example4.pl0000444000175000017500000000572011442272645016160 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: example4.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2008-2009 David M. Town # 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 warnings; use Net::SNMP; my $OID_sysUpTime = '1.3.6.1.2.1.1.3.0'; my $OID_sysContact = '1.3.6.1.2.1.1.4.0'; my $OID_sysLocation = '1.3.6.1.2.1.1.6.0'; # Hash of hosts and location data. my %host_data = ( '10.1.1.2' => 'Building 1, Second Floor', '10.2.1.1' => 'Building 2, First Floor', 'localhost' => 'Right here!', ); # Create a session for each host and queue a get-request for sysUpTime. for my $host (keys %host_data) { my ($session, $error) = Net::SNMP->session( -hostname => $host, -community => 'private', -nonblocking => 1, ); if (!defined $session) { printf "ERROR: Failed to create session for host '%s': %s.\n", $host, $error; next; } my $result = $session->get_request( -varbindlist => [ $OID_sysUpTime ], -callback => [ \&get_callback, $host_data{$host} ], ); if (!defined $result) { printf "ERROR: Failed to queue get request for host '%s': %s.\n", $session->hostname(), $session->error(); } } # Now initiate the SNMP message exchange. snmp_dispatcher(); exit 0; sub get_callback { my ($session, $location) = @_; my $result = $session->var_bind_list(); if (!defined $result) { printf "ERROR: Get request failed for host '%s': %s.\n", $session->hostname(), $session->error(); return; } printf "The sysUpTime for host '%s' is %s.\n", $session->hostname(), $result->{$OID_sysUpTime}; # Now set the sysContact and sysLocation for the host. $result = $session->set_request( -varbindlist => [ $OID_sysContact, OCTET_STRING, 'Help Desk x911', $OID_sysLocation, OCTET_STRING, $location, ], -callback => \&set_callback, ); if (!defined $result) { printf "ERROR: Failed to queue set request for host '%s': %s.\n", $session->hostname(), $session->error(); } return; } sub set_callback { my ($session) = @_; my $result = $session->var_bind_list(); if (defined $result) { printf "The sysContact for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysContact}; printf "The sysLocation for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysLocation}; } else { printf "ERROR: Set request failed for host '%s': %s.\n", $session->hostname(), $session->error(); } return; } # ============================================================================ Net-SNMP-v6.0.1/examples/snmpget.pl0000444000175000017500000000636611442272645016125 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpget.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP 6.0 qw( snmp_type_ntop DEBUG_ALL ); use Getopt::Std; our $SCRIPT = 'snmpget'; our $VERSION = 'v6.0.0'; our %OPTS; # Validate the command line options. if (!getopts('a:A:c:dD:E:m:n:p:r:t:u:v:x:X:', \%OPTS)) { usage(); } # Do we have enough information? if (@ARGV < 2) { usage(); } # Create the SNMP session. my ($s, $e) = Net::SNMP->session( -hostname => shift, exists($OPTS{a}) ? (-authprotocol => $OPTS{a}) : (), exists($OPTS{A}) ? (-authpassword => $OPTS{A}) : (), exists($OPTS{c}) ? (-community => $OPTS{c}) : (), exists($OPTS{D}) ? (-domain => $OPTS{D}) : (), exists($OPTS{d}) ? (-debug => DEBUG_ALL) : (), exists($OPTS{m}) ? (-maxmsgsize => $OPTS{m}) : (), exists($OPTS{p}) ? (-port => $OPTS{p}) : (), exists($OPTS{r}) ? (-retries => $OPTS{r}) : (), exists($OPTS{t}) ? (-timeout => $OPTS{t}) : (), exists($OPTS{u}) ? (-username => $OPTS{u}) : (), exists($OPTS{v}) ? (-version => $OPTS{v}) : (), exists($OPTS{x}) ? (-privprotocol => $OPTS{x}) : (), exists($OPTS{X}) ? (-privpassword => $OPTS{X}) : (), ); # Was the session created? if (!defined $s) { abort($e); } my @args = ( exists($OPTS{E}) ? (-contextengineid => $OPTS{E}) : (), exists($OPTS{n}) ? (-contextname => $OPTS{n}) : (), -varbindlist => \@ARGV, ); # Send the SNMP message. if (!defined $s->get_request(@args)) { abort($s->error()); } # Print the results. for ($s->var_bind_names()) { printf "%s = %s: %s\n", $_, snmp_type_ntop($s->var_bind_types()->{$_}), $s->var_bind_list()->{$_}; } # Close the session. $s->close(); exit 0; # [functions] ---------------------------------------------------------------- sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { print << "USAGE"; $SCRIPT $VERSION Copyright (c) 2000-2009 David M. Town. All rights reserved. Usage: $SCRIPT [options] [...] Options: -v 1|2c|3 SNMP version -d Enable debugging SNMPv1/SNMPv2c: -c Community name SNMPv3: -u Username (required) -E Context Engine ID -n Context Name -a Authentication protocol -A Authentication password -x Privacy protocol -X Privacy password Transport Layer: -D Domain -m Maximum message size -p Destination port -r Number of retries -t Timeout period USAGE exit 1; } # ============================================================================ Net-SNMP-v6.0.1/examples/snmpgetnext.pl0000444000175000017500000000640311442272645017014 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpgetnext.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP 6.0 qw( snmp_type_ntop DEBUG_ALL ); use Getopt::Std; our $SCRIPT = 'snmpgetnext'; our $VERSION = 'v6.0.0'; our %OPTS; # Validate the command line options. if (!getopts('a:A:c:dD:E:m:n:p:r:t:u:v:x:X:', \%OPTS)) { usage(); } # Do we have enough information? if (@ARGV < 2) { usage(); } # Create the SNMP session. my ($s, $e) = Net::SNMP->session( -hostname => shift, exists($OPTS{a}) ? (-authprotocol => $OPTS{a}) : (), exists($OPTS{A}) ? (-authpassword => $OPTS{A}) : (), exists($OPTS{c}) ? (-community => $OPTS{c}) : (), exists($OPTS{D}) ? (-domain => $OPTS{D}) : (), exists($OPTS{d}) ? (-debug => DEBUG_ALL) : (), exists($OPTS{m}) ? (-maxmsgsize => $OPTS{m}) : (), exists($OPTS{p}) ? (-port => $OPTS{p}) : (), exists($OPTS{r}) ? (-retries => $OPTS{r}) : (), exists($OPTS{t}) ? (-timeout => $OPTS{t}) : (), exists($OPTS{u}) ? (-username => $OPTS{u}) : (), exists($OPTS{v}) ? (-version => $OPTS{v}) : (), exists($OPTS{x}) ? (-privprotocol => $OPTS{x}) : (), exists($OPTS{X}) ? (-privpassword => $OPTS{X}) : (), ); # Was the session created? if (!defined $s) { abort($e); } my @args = ( exists($OPTS{E}) ? (-contextengineid => $OPTS{E}) : (), exists($OPTS{n}) ? (-contextname => $OPTS{n}) : (), -varbindlist => \@ARGV, ); # Send the SNMP message. if (!defined $s->get_next_request(@args)) { abort($s->error()); } # Print the results. for ($s->var_bind_names()) { printf "%s = %s: %s\n", $_, snmp_type_ntop($s->var_bind_types()->{$_}), $s->var_bind_list()->{$_}; } # Close the session. $s->close(); exit 0; # [functions] ---------------------------------------------------------------- sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { print << "USAGE"; $SCRIPT $VERSION Copyright (c) 2000-2009 David M. Town. All rights reserved. Usage: $SCRIPT [options] [...] Options: -v 1|2c|3 SNMP version -d Enable debugging SNMPv1/SNMPv2c: -c Community name SNMPv3: -u Username (required) -E Context Engine ID -n Context Name -a Authentication protocol -A Authentication password -x Privacy protocol -X Privacy password Transport Layer: -D Domain -m Maximum message size -p Destination port -r Number of retries -t Timeout period USAGE exit 1; } # ============================================================================ Net-SNMP-v6.0.1/examples/example3.pl0000444000175000017500000000532011442272645016153 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: example3.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2001-2009 David M. Town # 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 warnings; use Net::SNMP qw(:snmp); my $OID_ifTable = '1.3.6.1.2.1.2.2'; my $OID_ifPhysAddress = '1.3.6.1.2.1.2.2.1.6'; my ($session, $error) = Net::SNMP->session( -hostname => shift || 'localhost', -community => shift || 'public', -nonblocking => 1, -translate => [-octetstring => 0], -version => 'snmpv2c', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my %table; # Hash to store the results my $result = $session->get_bulk_request( -varbindlist => [ $OID_ifTable ], -callback => [ \&table_callback, \%table ], -maxrepetitions => 10, ); if (!defined $result) { printf "ERROR: %s\n", $session->error(); $session->close(); exit 1; } # Now initiate the SNMP message exchange. snmp_dispatcher(); $session->close(); # Print the results, specifically formatting ifPhysAddress. for my $oid (oid_lex_sort(keys %table)) { if (!oid_base_match($OID_ifPhysAddress, $oid)) { printf "%s = %s\n", $oid, $table{$oid}; } else { printf "%s = %s\n", $oid, unpack 'H*', $table{$oid}; } } exit 0; sub table_callback { my ($session, $table) = @_; my $list = $session->var_bind_list(); if (!defined $list) { printf "ERROR: %s\n", $session->error(); return; } # Loop through each of the OIDs in the response and assign # the key/value pairs to the reference that was passed with # the callback. Make sure that we are still in the table # before assigning the key/values. my @names = $session->var_bind_names(); my $next = undef; while (@names) { $next = shift @names; if (!oid_base_match($OID_ifTable, $next)) { return; # Table is done. } $table->{$next} = $list->{$next}; } # Table is not done, send another request, starting at the last # OBJECT IDENTIFIER in the response. No need to include the # calback argument, the same callback that was specified for the # original request will be used. my $result = $session->get_bulk_request( -varbindlist => [ $next ], -maxrepetitions => 10, ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); } return; } # ============================================================================ Net-SNMP-v6.0.1/examples/snmpset.pl0000444000175000017500000001167311442272645016136 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpset.pl,v 6.0 2009/09/09 15:05:33 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP 6.0 qw( :asn1 snmp_type_ntop DEBUG_ALL ); use Getopt::Std; our $SCRIPT = 'snmpset'; our $VERSION = 'v6.0.0'; our %OPTS; # Validate the command line options. if (!getopts('a:A:c:dD:E:m:n:p:r:t:u:v:x:X:', \%OPTS)) { usage(); } # Do we have enough information? if (@ARGV < 4) { usage(); } # Create the SNMP session. my ($s, $e) = Net::SNMP->session( -hostname => shift, exists($OPTS{a}) ? (-authprotocol => $OPTS{a}) : (), exists($OPTS{A}) ? (-authpassword => $OPTS{A}) : (), exists($OPTS{c}) ? (-community => $OPTS{c}) : (), exists($OPTS{D}) ? (-domain => $OPTS{D}) : (), exists($OPTS{d}) ? (-debug => DEBUG_ALL) : (), exists($OPTS{m}) ? (-maxmsgsize => $OPTS{m}) : (), exists($OPTS{p}) ? (-port => $OPTS{p}) : (), exists($OPTS{P}) ? (-protocol => $OPTS{P}) : (), exists($OPTS{r}) ? (-retries => $OPTS{r}) : (), exists($OPTS{t}) ? (-timeout => $OPTS{t}) : (), exists($OPTS{u}) ? (-username => $OPTS{u}) : (), exists($OPTS{v}) ? (-version => $OPTS{v}) : (), exists($OPTS{x}) ? (-privprotocol => $OPTS{x}) : (), exists($OPTS{X}) ? (-privpassword => $OPTS{X}) : (), ); # Was the session created? if (!defined $s) { abort($e); } # Convert the ASN.1 types to the respresentation expected by Net::SNMP. if (convert_asn1_types(\@ARGV)) { usage(); } my @args = ( exists($OPTS{E}) ? (-contextengineid => $OPTS{E}) : (), exists($OPTS{n}) ? (-contextname => $OPTS{n}) : (), -varbindlist => \@ARGV, ); # Send the SNMP message. if (!defined $s->set_request(@args)) { abort($s->error()); } # Print the results. for ($s->var_bind_names()) { printf "%s = %s: %s\n", $_, snmp_type_ntop($s->var_bind_types()->{$_}), $s->var_bind_list()->{$_}; } # Close the session. $s->close(); exit 0; # [functions] ---------------------------------------------------------------- sub convert_asn1_types { my ($argv) = @_; # Mapping table: { "user input character" => constant byte value } my %asn1_types = ( 'a' => IPADDRESS, 'c' => COUNTER32, 'C' => COUNTER64, 'g' => GAUGE32, 'h' => OCTET_STRING, 'i' => INTEGER32, 'o' => OBJECT_IDENTIFIER, 'p' => OPAQUE, 's' => OCTET_STRING, 't' => TIMETICKS, ); # Expect [OBJECT IDENTIFIER, ASN.1 type, object value] combination. if ((ref($argv) ne 'ARRAY') || (scalar(@{$argv}) % 3)) { return 1; } for (my $i = 0; $i < scalar @{$argv}; $i += 3) { if (exists $asn1_types{$argv->[$i+1]}) { if ($argv->[$i+1] eq 'h') { if ($argv->[$i+2] =~ m/^(?:0x)?([A-F\d]+)$/i) { # Convert hexadecimal string. $argv->[$i+2] = pack 'H*', length($1) % 2 ? '0'.$1 : $1; } else { abort(sprintf q{The string "%s" is is expected in } . q{hexadecimal format for type 'h'}, $argv->[$i+2]); } } $argv->[$i+1] = $asn1_types{$argv->[$i+1]}; } else { abort(sprintf 'The ASN.1 type "%s" is unknown', $argv->[$i+1]); } } return 0; } sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { print << "USAGE"; $SCRIPT $VERSION Copyright (c) 2000-2009 David M. Town. All rights reserved. Usage: $SCRIPT [options] [...] Options: -v 1|2c|3 SNMP version -d Enable debugging SNMPv1/SNMPv2c: -c Community name SNMPv3: -u Username (required) -E Context Engine ID -n Context Name -a Authentication protocol -A Authentication password -x Privacy protocol -X Privacy password Transport Layer: -D Domain -m Maximum message size -p Destination port -r Number of retries -t Timeout period Valid type values: a - IpAddress i - INTEGER c - Counter o - OBJECT IDENTIFIER C - Counter64 p - Opaque g - Gauge/Unsigned32 s - OCTET STRING h - OCTET STRING (hex) t - TimeTicks USAGE exit 1; } # ============================================================================ Net-SNMP-v6.0.1/examples/example1.pl0000444000175000017500000000216211442272645016152 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: example1.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP; my $OID_sysUpTime = '1.3.6.1.2.1.1.3.0'; my ($session, $error) = Net::SNMP->session( -hostname => shift || 'localhost', -community => shift || 'public', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my $result = $session->get_request(-varbindlist => [ $OID_sysUpTime ],); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); $session->close(); exit 1; } printf "The sysUpTime for host '%s' is %s.\n", $session->hostname(), $result->{$OID_sysUpTime}; $session->close(); exit 0; # ============================================================================ Net-SNMP-v6.0.1/examples/example2.pl0000444000175000017500000000257311442272645016161 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: example2.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP; my $OID_sysContact = '1.3.6.1.2.1.1.4.0'; my ($session, $error) = Net::SNMP->session( -hostname => 'myv3host.example.com', -version => 'snmpv3', -username => 'myv3Username', -authprotocol => 'sha1', -authkey => '0x6695febc9288e36282235fc7151f128497b38f3f', -privprotocol => 'des', -privkey => '0x6695febc9288e36282235fc7151f1284', ); if (!defined $session) { printf "ERROR: %s.\n", $error; exit 1; } my $result = $session->set_request( -varbindlist => [ $OID_sysContact, OCTET_STRING, 'Help Desk x911' ], ); if (!defined $result) { printf "ERROR: %s.\n", $session->error(); $session->close(); exit 1; } printf "The sysContact for host '%s' was set to '%s'.\n", $session->hostname(), $result->{$OID_sysContact}; $session->close(); exit 0; # ============================================================================ Net-SNMP-v6.0.1/examples/snmpwalk.pl0000444000175000017500000001170611442272645016276 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpwalk.pl,v 6.0 2009/09/09 15:05:33 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP 6.0 qw( :snmp DEBUG_ALL ENDOFMIBVIEW ); use Getopt::Std; our $SCRIPT = 'snmpwalk'; our $VERSION = 'v6.0.0'; our %OPTS; # Validate the command line options. if (!getopts('a:A:c:CdD:E:m:n:p:r:t:u:v:x:X:', \%OPTS)) { usage(); } # Do we have enough/too much information? if (@ARGV != 2) { if (@ARGV == 1) { push @ARGV, '1.3.6.1.2.1'; # mib-2 } else { usage(); } } # Create the SNMP session. my ($s, $e) = Net::SNMP->session( -hostname => shift, exists($OPTS{a}) ? (-authprotocol => $OPTS{a}) : (), exists($OPTS{A}) ? (-authpassword => $OPTS{A}) : (), exists($OPTS{c}) ? (-community => $OPTS{c}) : (), exists($OPTS{D}) ? (-domain => $OPTS{D}) : (), exists($OPTS{d}) ? (-debug => DEBUG_ALL) : (), exists($OPTS{m}) ? (-maxmsgsize => $OPTS{m}) : (), exists($OPTS{p}) ? (-port => $OPTS{p}) : (), exists($OPTS{r}) ? (-retries => $OPTS{r}) : (), exists($OPTS{t}) ? (-timeout => $OPTS{t}) : (), exists($OPTS{u}) ? (-username => $OPTS{u}) : (), exists($OPTS{v}) ? (-version => $OPTS{v}) : (), exists($OPTS{x}) ? (-privprotocol => $OPTS{x}) : (), exists($OPTS{X}) ? (-privpassword => $OPTS{X}) : (), ); # Was the session created? if (!defined $s) { abort($e); } # Perform repeated get-next-requests or get-bulk-requests (SNMPv2c/v3) # until the last returned OBJECT IDENTIFIER is no longer a child of # the OBJECT IDENTIFIER passed in on the command line. my @args = ( exists($OPTS{E}) ? (-contextengineid => $OPTS{E}) : (), exists($OPTS{n}) ? (-contextname => $OPTS{n}) : (), -varbindlist => [($ARGV[0] eq q{.}) ? '0' : $ARGV[0]], ); my $last_oid = $ARGV[0]; if ($s->version() == SNMP_VERSION_1) { while (defined $s->get_next_request(@args)) { my $oid = ($s->var_bind_names())[0]; lex_check($last_oid, $oid); if (!oid_base_match($ARGV[0], $oid)) { last; } display($s, ($last_oid = $oid)); @args = (-varbindlist => [$last_oid]); } } else { push @args, -maxrepetitions => 25; GET_BULK: while (defined $s->get_bulk_request(@args)) { my @oids = $s->var_bind_names(); if (!scalar @oids) { abort('Received an empty varBindList'); } for my $oid (@oids) { # Make sure we have not hit the end of the MIB. if ($s->var_bind_types()->{$oid} == ENDOFMIBVIEW) { display($s, $oid); last GET_BULK; } lex_check($last_oid, $oid); if (!oid_base_match($ARGV[0], $oid)) { last GET_BULK; } display($s, ($last_oid = $oid)); } @args = (-maxrepetitions => 25, -varbindlist => [$last_oid]); } } # Let the user know about any errors. if ($s->error()) { abort($s->error()); } # Close the session. $s->close(); exit 0; # [functions] ---------------------------------------------------------------- sub display { my ($s, $oid) = @_; printf "%s = %s: %s\n", $oid, snmp_type_ntop($s->var_bind_types()->{$oid}), $s->var_bind_list()->{$oid}; return; } sub lex_check { my ($current, $next) = @_; return if exists $OPTS{C}; if (oid_lex_cmp($current, $next) >= 0) { printf "%s: Lexicographical error detected in response.\n", $SCRIPT; printf " Current: %s\n", $current; printf " Next: %s\n", $next; exit 1; } return; } sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { print << "USAGE"; $SCRIPT $VERSION Copyright (c) 2000-2009 David M. Town. All rights reserved. Usage: $SCRIPT [options] [oid] Options: -v 1|2c|3 SNMP version -C Do not check lexicographical ordering -d Enable debugging SNMPv1/SNMPv2c: -c Community name SNMPv3: -u Username (required) -E Context Engine ID -n Context Name -a Authentication protocol -A Authentication password -x Privacy protocol -X Privacy password Transport Layer: -D Domain -m Maximum message size -p Destination port -r Number of retries -t Timeout period USAGE exit 1; } # ============================================================================ Net-SNMP-v6.0.1/examples/snmpgetbulk.pl0000444000175000017500000000655611442272645017004 0ustar dtowndtown#! /bin/env perl # ============================================================================ # $Id: snmpgetbulk.pl,v 6.0 2009/09/09 15:05:32 dtown Rel $ # Copyright (c) 2000-2009 David M. Town # 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 warnings; use Net::SNMP 6.0 qw( snmp_type_ntop DEBUG_ALL ); use Getopt::Std; our $SCRIPT = 'snmpgetbulk'; our $VERSION = 'v6.0.0'; our %OPTS; # Validate the command line options. if (!getopts('a:A:c:dD:E:m:n:p:r:t:u:v:x:X:', \%OPTS)) { usage(); } # Do we have enough information? if (@ARGV < 4) { usage(); } # Create the SNMP session. my ($s, $e) = Net::SNMP->session( -hostname => shift, exists($OPTS{a}) ? (-authprotocol => $OPTS{a}) : (), exists($OPTS{A}) ? (-authpassword => $OPTS{A}) : (), exists($OPTS{c}) ? (-community => $OPTS{c}) : (), exists($OPTS{D}) ? (-domain => $OPTS{D}) : (), exists($OPTS{d}) ? (-debug => DEBUG_ALL) : (), exists($OPTS{m}) ? (-maxmsgsize => $OPTS{m}) : (), exists($OPTS{p}) ? (-port => $OPTS{p}) : (), exists($OPTS{r}) ? (-retries => $OPTS{r}) : (), exists($OPTS{t}) ? (-timeout => $OPTS{t}) : (), exists($OPTS{u}) ? (-username => $OPTS{u}) : (), exists($OPTS{v}) ? (-version => $OPTS{v}) : (-version => 'snmpv2c'), exists($OPTS{x}) ? (-privprotocol => $OPTS{x}) : (), exists($OPTS{X}) ? (-privpassword => $OPTS{X}) : (), ); # Was the session created? if (!defined $s) { abort($e); } my @args = ( exists($OPTS{E}) ? (-contextengineid => $OPTS{E}) : (), exists($OPTS{n}) ? (-contextname => $OPTS{n}) : (), -nonrepeaters => shift, -maxrepetitions => shift, -varbindlist => \@ARGV, ); # Send the SNMP message. if (!defined $s->get_bulk_request(@args)) { abort($s->error()); } # Print the results. for ($s->var_bind_names()) { printf "%s = %s: %s\n", $_, snmp_type_ntop($s->var_bind_types()->{$_}), $s->var_bind_list()->{$_}; } # Close the session. $s->close(); exit 0; # [functions] ---------------------------------------------------------------- sub abort { printf "$SCRIPT: " . ((@_ > 1) ? shift(@_) : '%s') . ".\n", @_; exit 1; } sub usage { print << "USAGE"; $SCRIPT $VERSION Copyright (c) 2000-2009 David M. Town. All rights reserved. Usage: $SCRIPT [options] [...] Options: -v 2c|3 SNMP version -d Enable debugging SNMPv2c: -c Community name SNMPv3: -u Username (required) -E Context Engine ID -n Context Name -a Authentication protocol -A Authentication password -x Privacy protocol -X Privacy password Transport Layer: -D Domain -m Maximum message size -p Destination port -r Number of retries -t Timeout period USAGE exit 1; } # ============================================================================ Net-SNMP-v6.0.1/LICENSE0000444000175000017500000004360211442272645013274 0ustar dtowndtownThis software is copyright (c) 2010 by David M. Town . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2010 by David M. Town . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2010 by David M. Town . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-SNMP-v6.0.1/Changes0000444000175000017500000003752211442272645013566 0ustar dtowndtown Net::SNMP Changes RELEASE 6.0.1 SEP-09-2010 - Removed all occurrences of the "locked" attribute that was deprecated in Perl 5.12.0. - Changed the test validating the presence of a monotonic time value to check for invalid implementations. - The SNMPv3 contextEngineID and contextName are now stored as part of the request allowing for these values to be changed between messages. RELEASE 6.0.0 SEP-09-2009 - Substantial internal code cleanup was performed based upon the Perl::Critic module and the "Perl Best Practices" book. - Added support for the Module::Build system for building, testing, and installing Perl modules. - The translation logic for OCTET STRINGs now uses the definition of a DisplayString in RFC 2579 to determine if the octets are to be converted into a hexadecimal representation. - The get_table() and get_entries() methods were refactored as part of the code cleanup. The get_entries() method now handles "holes" in tables better and indexes with a value of zero. - The inheritance structure of the Transport Domain objects was updated to reduce code duplication and increase maintainability. - The resolution of IPv6 addresses was made more exhaustive. - The handling of OBJECT IDENTIFIERs was made more efficient by using [un]pack() with a BER compressed integer template. - Additional validation of the values passed to most methods is now performed and the error messages have been made more robust. - The documented examples were updated based upon commonly asked questions (specifically Example 3 and Example 4). - A Response-PDU with an error-status set to "noError" no longer generates an error when the error-index is non-zero, as decribed in Section 4.2.4 of RFC 3416. - The function oid_lex_cmp() was added to provide for the lexicographical comparison of two OBJECT IDENTIFIERs. - The error-status is no longer set for the exceptions noSuchObject, noSuchInstance, and endOfMibView when translation is not enabled. RELEASE 5.2.0 OCT-20-2005 - Removed the dependency on the IO::Socket::INET and IO::Socket::INET6 modules. The IO::Socket module is now used for all socket objects. - The port information can now be included as part of the transport address specified with the session() Transport Domain arguments. - Added support for specifying the scope zone index for IPv6 addresses as described in RFC 4007 - "IPv6 Scoped Address Architecture". - The default value for the agent-addr in SNMPv1 Trap-PDUs is now the IP address associated with the interface on which the trap will be transmitted. RELEASE 5.1.0 JUL-20-2005 - Support of the AES privacy protocol was updated to be compliant with RFC 3826 - "The Advanced Encryption Standard (AES) Cipher Algorithm in the SNMP User-based Security Model". - Corrected an issue where any non-blocking SNMPv3 message queued prior to calling snmp_dispatcher() was sent with an empty contextEngineID. - The first SNMPv3 discovery message is again being sent with a zero- length msgUserName as suggested by RFC 3414. - All sockets are now flagged as non-blocking to prevent a possible deadlock due to an interaction between recv() and select(). - The sending of messages is now bounded by the receive processing rate to avoid receive buffer overflows. - The return value of select() is now checked for both "undef" and -1. - The "usm.t" tests are now skipped if any of the non-core modules required by the Net::SNMP::Security::USM module are not present. RELEASE 5.0.1 SEP-09-2004 - The module is now again functional with Perl 5.6.x. Compensations were made for compatibility problems with the IO::Socket::INET and Math::BigInt modules packaged with Perl 5.6.x. - The UDP/IPv6 and TCP/IPv6 Transport Domains are now functional when using version 2.0x of the IO::Socket::INET6 module. RELEASE 5.0.0 JUL-20-2004 - Added support for the UDP/IPv6 Transport Domain listed in RFC 3419. - Support for the TCP/IPv4 and TCP/IPv6 Transport Domains was added as described in RFC 3430 - "SNMP over TCP Transport Mapping". - Optimizations were made to ASN.1 processing and preparation methods. - Corrected a possible memory exhaustion error with OCTET STRINGs that contain "printf" format characters. - The ASN.1 types associated with the ObjectSyntax values in the VarBindList can now be retrieved using the var_bind_types() method. - The function snmp_type_ntop() was added for displaying ASN.1 types. - The Net::SNMP::Dispatcher module now checks for select() errors. - Passing the "-maxrepetitions" argument with a value of 1 or less to the get_table() or get_entries() methods instructs them to use get-next-request messages instead of get-bulk-request messages. - The maximum allowed value for the maxMsgSize was reduced to 65535. - The Perl modules for the non-default Transport Domains and Security Model are now loaded at runtime instead of compile time. RELEASE 4.1.2 SEP-11-2003 - Removed an unintended dependency on the Crypt::Rijndael that would cause SNMPv3 support to be unavailable and the "usm.t" tests to fail due to a "strict subs" error in Net::SNMP::Security::USM module. RELEASE 4.1.1 SEP-09-2003 - Corrected a misinterpretation of the "The AES Cipher Algorithm in the SNMP's User-based Security Model" draft specification that lead to the incorrect encoding and decoding of the last block of the message. - The syntax of the get_entries() method was changed to expect the column values to entered as full OBJECT IDENTIFIERs allowing the traversal of conceptual rows in different tables which are indexed identically. - The processing of the serialization of an OBJECT IDENTIFIER was optimized. - The oid_lex_sort() function was updated to order OBJECT IDENTIFIER strings padded with spaces as lexicographically greater than unpadded strings. - An empty contextEngineId in a response message is now accepted during the SNMPv3 discovery process. - Corrected an argument validation error with the get_bulk_request() method. RELEASE 4.1.0 MAY-06-2003 - Working in conjunction with the Extended Security Options Consortium (http://www.snmp.com/eso), support for additional privacy protocols has been added to the SNMPv3 User-based Security Model. "Extension to the USM to Support Triple-DES EDE in 'Outside' CBC Mode" Reeder and Gudmunsson; October 1999, expired April 2000 http://www.snmp.com/eso/draft-reeder-snmpv3-usm-3desede-00.txt "The AES Cipher Algorithm in the SNMP's User-based Security Model" Blumenthal, Maino, and McCloghrie; October 2002, expired April 2003 http://www.snmp.com/eso/draft-blumenthal-aes-usm-04.txt - A new method called get_entries() was added to allow the retrieval of columns of a table entry using get-next-requests or get-bulk-requests. - The argument "-maxrepetitions" was added to the get_table() method. - Responses to SNMPv3 messages with non-default contextEngineIDs or contextNames are now properly processed. - The method var_bind_names() was added to retrieve an array of the ObjectNames in the VarBindList in the order in which they were received in the GetResponse-PDU. RELEASE 4.0.3 SEP-09-2002 - Net::SNMP objects are now destroyed as expected when they are no longer referenced. An internal reference to the object allocated by the Net::SNMP::Dispatcher module is now properly cleared. - A socket with a file descriptor value of 0 is now accepted by the Net::SNMP module as a valid and open filehandle. - Removed an "optimization" which was intended to provide a smoother initialization of the dispatcher but instead could lead to messages incorrectly timing out. RELEASE 4.0.2 MAY-06-2002 - The SNMPv3 request message sent for time synchronization is now sent with the same securityLevel that is configured for the session. - The "reserved" bits in the msgFlags field of an incoming SNMPv3 message are now ignored as suggested by RFC 2572. - When encrypting a SNMPv3 message, the padding byte(s) are now set to a value equal to the size of the padding. "The actual pad value is irrelevant..." according RFC 2574 Section 8.1.1.2. However, there are some agents that expect this byte pattern. - Corrected a reference count mismatch which would leave a listening socket open if no response is received from the remote agent. - Corrected a "deep recursion" error that occurred when using the get_table() method to retrieve large tables in blocking mode. - Using the "-delay" argument with the get_table() method no longer incorrectly delays between message exchanges when retrieving the table. - Optimizations and improvements were made to the Net::SNMP::Dispatcher event scheduling and handling procedures. - The "translate unsigned" logic now correctly handles properly formatted (but unexpected) negative Counter64, Counter, Gauge, and TimeTick values. RELEASE 4.0.1 JAN-01-2002 - SNMPv3 objects using authentication now send a separate authenticated request message for time synchronization while performing discovery. - Non-blocking SNMPv1/2c messages with a "-delay" argument which are queued before entering the event loop are no longer incorrectly discarded. - The Net::SNMP::Security::Community::security_model() method now returns the correct value as reserved by RFC 2571. - The first subidentifier in an OBJECT IDENTIFIER is now restricted to ccitt(0), iso(1), or joint-iso-ccitt(2) as specified by ISO/IEC 8825. - Changed the appropriate CHECK blocks into BEGIN blocks to avoid the "Can't call method 'send_pdu' on an undefined value" error when the module is loaded using a quoted eval statement. RELEASE 4.0.0 NOV-09-2001 - The module has been completely redesigned to add support for SNMPv3 and to follow the SNMP Management Framework defined by RFC 2571. - Perl version 5.6.0 or greater is now required to use the module. - Updated the method calls to expect the same argument syntax regardless of whether they are invoked by "blocking" or "non-blocking" objects. - The non-core modules Crypt::DES, Digest::MD5, Digest::SHA1, and Digest::HMAC are now required to support SNMPv3. - Added the ability to specify the local address and port number used by each object. RELEASE 3.65 SEP-09-2001 - Corrected an error in the Net::SNMP::FSM module that would cause all response messages to be dropped in "non-blocking" mode if there is a recv() error. - Updated the logic in the "blocking" response handling method such the transmit buffer is properly updated if there is a decode error while parsing the GetResponse-PDU. - Counter, Gauge, and TimeTick values that are incorrectly encoded as negative signed integers are now converted to unsigned values. This feature can be disabled by setting the "-unsigned" flag to false using the translate() method. - An empty community name is now allowed. - Updated the "non-blocking" example script. RELEASE 3.60 SEP-09-2000 - Translation can now be enabled or disabled on a per ASN.1 type basis. - The Net::SNMP::FSM "event loop" now prioritizes processing SNMP responses over other actions. - A set of example scripts is now included with the distribution. RELEASE 3.50 MAY-06-2000 - The methods that expect a SNMP GetResponse-PDU in "blocking" mode now ignore messages with request-ids that do not match the current request-id. This change addresses a common occurrence of the "Received request-id xxxx is not equal to transmitted request-id xxxx" error. The manifestation of this error that has been corrected occurs when a remote agent is too busy to respond immediately, buffers the request, and responds to the request after the Net::SNMP timeout has expired. - A new argument "-delay" was added to all methods that can function in "non- blocking" mode. - The Net::SNMP::FSM "event loop" sub-module was completely rewritten to more logically handle events. - The get_table() method now uses get-bulk-requests instead of get-next-requests when the calling object's version is SNMPv2c. - When a duplicate OBJECT IDENTIFIER is received in the VarBindList of a GetResponse-PDU, the duplicate is now padded with an appropriate number of spaces to make it an unique key in the HASH reference returned by the object. - The default Maximum Transport Unit was changed from 484 to 1500. The minimum allow MTU is now 484. RELEASE 3.01 JAN-01-2000 - Performance enhancements were made to the most heavily used methods. - Changed the default timeout to 5.0 seconds and the default number of retries to 1 to reduce network traffic and to work around a problem with responses from certain routers when they are busy. The total default timeout period remains the same at 10 seconds. - Removed the verify_ip() method and the "-verifyip" argument to the constructor. RELEASE 3.00 SEP-09-1999 - Added event loop based "non-blocking" support. - Deprecated the verify_ip() method because verification of the received IP address and port number is no longer done. - The "null" character (\000) no longer triggers an OCTET STRING in a GetResponse-PDU to be converted to a hexadecimal representation if translation is enabled. - A single socket is now used for all Net::SNMP objects. - Corrected an error where a blocking session would send one too many retries and fail to listen for the last message sent. - Added a new export tag ":snmp" used to define SNMP related symbols. - New utility functions oid_context_match(), oid_lex_sort(), and ticks_to_time() were added to provide support for commonly requested tasks. - The length of the varBind SEQUENCE is now properly encoded when multiple varBinds exist. RELEASE 2.00 MAY-06-1999 - Added support for SNMPv2c (Community-Based SNMPv2). - Modified the ASN.1 encode routine for INTEGERs to correctly handle positive values greater than 8388607. - Added an installation test to verify basic usage of the module, including verification of basic encode and decode methods. RELEASE 1.40 APR-26-1999 - All parameters for the object that used to be only configurable via an object method can now be modified at object creation by passing named arguments to the constructor. - The translate() and debug() methods were modified to require a boolean argument to enable or disable the feature. This deprecates the toggle functionality they had previously. - New method verify_ip() added that enables or disables the verification of the IP address and UDP port number on datagrams received by the object. - Added support for decoding ASN.1 lengths encoded with 3 or 4 bytes. - Installation tests for the modules required by Net::SNMP and for basic socket functionality were added to the distribution. RELEASE 1.30 MAR-17-1999 - Modified the OBJECT INDENTIFIER decode method to return a leading dot on all identifiers if there was a leading dot on any OBJECT IDENTIFIER passed to the encode method. - Changed the address comparison used when receiving an UDP packet to just include the port and address information in order to work around an AIX problem. RELEASE 1.20 NOV-06-1998 - Now use gensym() from the Symbol module to generate typeglob references for socket handles, correcting a memory leak. - All private methods renamed to Perl programming style recommendations. RELEASE 1.10 OCT-14-1998 - New method trap() for sending SNMP Trap-PDUs added. - New method error_status() which retrieves the SNMP error-status contained in the last SNMP GetResponse-PDU added. - Named arguments for the method session() are now validated. - New export tags ":asn1", ":generictrap", and ":ALL" added. - New exportable symbols for generic-trap types added. - A comma contained in an OCTET STRING no longer causes the decoded result of a GetResponse-PDU to be converted to a hexadecimal representation if translation is enabled. - The control characters \n\r\t no longer trigger an OCTET STRING in a GetResponse-PDU to be converted to a hexadecimal representation if translation is enabled. RELEASE 1.00 SEP-09-1998 - Initial release. RCS $Id: Changes,v 6.1 2010/09/10 00:01:22 dtown Rel $ Net-SNMP-v6.0.1/README0000444000175000017500000000522311442272645013144 0ustar dtowndtown Net::SNMP, version 6.0.1 NAME Net::SNMP - Object oriented interface to SNMP DESCRIPTION The Net::SNMP module implements an object oriented interface to the Simple Network Management Protocol. Perl applications can use the module to retrieve or update information on a remote host using the SNMP protocol. The module supports SNMP version-1, SNMP version-2c (Community-Based SNMPv2), and SNMP version-3. The Net::SNMP module assumes that the user has a basic understanding of the Simple Network Management Protocol and related network management concepts. INSTALLATION To install the Net::SNMP module and all of it's dependencies directly from the Comprehensive Perl Archive Network (CPAN) execute the command: perl -MCPAN -e "install Net::SNMP" The Net::SNMP module can also be installed using the distribution file downloaded from CPAN. After unpacking the file, perform one of the following steps while in the top level directory of the distribution: a. Create a makefile by running Perl against Makefile.PL and then run make: perl Makefile.PL make test make install b. If the Module::Build module is installed, create a Build script by running Perl against Build.PL and then use it to install the module: perl Build.PL perl Build perl Build test perl Build install c. Copy or move the entire directory structure (including files) located under the lib/Net directory in the distribution into a directory named Net in a Perl library directory. REQUIREMENTS Net::SNMP uses syntax that is not supported in versions of Perl earlier than v5.6.0. The non-core modules Crypt::DES, Digest::MD5, Digest::SHA1, and Digest::HMAC are needed to support SNMPv3. In order to support the AES Cipher Algorithm as a SNMPv3 privacy protocol, the non-core module Crypt::Rijndael is needed. To use UDP/IPv6 or TCP/IPv6 as a Transport Domain, the non-core module Socket6 is needed. DOCUMENTATION Documentation is included as part of the Net::SNMP module in Plain Old Documentation (POD) format. AUTHOR David M. Town LICENSE AND COPYRIGHT Copyright (c) 1998-2010 David M. Town. 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. RCS $Id: README,v 6.1 2010/09/10 00:01:22 dtown Rel $ Net-SNMP-v6.0.1/Makefile.PL0000444000175000017500000000336311442272645014241 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: Makefile.PL,v 6.0 2009/09/09 15:07:28 dtown Rel $ # Makefile for the Perl module Net::SNMP. # Copyright (c) 1998-2009 David M. Town # 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. # ============================================================================ eval { require 5.006 } or die <<'EOD'; This version of Net::SNMP uses syntax that is not supported in versions of Perl earlier than v5.6.0. Unable to install Net::SNMP with the current version of Perl. EOD use ExtUtils::MakeMaker qw(WriteMakefile); WriteMakefile( AUTHOR => 'David M. Town ', ABSTRACT => 'Object oriented interface to SNMP', NAME => 'Net::SNMP', DISTNAME => 'Net-SNMP', VERSION_FROM => 'lib/Net/SNMP.pm', EXE_FILES => [ 'snmpkey', ], PL_FILES => { 'snmpkey.PL' => 'snmpkey', }, PREREQ_PM => { Carp => 0, Errno => 0, Exporter => 0, IO::Socket => 0, Math::BigInt => 0, Crypt::DES => '2.03', # SNMPv3 Digest::MD5 => '2.11', # SNMPv3 Digest::SHA1 => '1.02', # SNMPv3 Digest::HMAC => '1.00', # SNMPv3 }, dist => { CI => 'ci -u -sRel -m\"Changes for $(VERSION)\"', RCS_LABEL => 'rcs -N$(VERSION_SYM): -q', COMPRESS => 'gzip --best', SUFFIX => 'gz', }, ($ExtUtils::MakeMaker::VERSION ge '6.31' ? ( 'LICENSE' => 'perl' ) : ()), ); exit 0; # ============================================================================ Net-SNMP-v6.0.1/META.yml0000444000175000017500000000401511442272645013533 0ustar dtowndtown--- abstract: 'Object oriented interface to SNMP' author: - 'David M. Town ' build_requires: Test: 0 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-SNMP provides: Net::SNMP: file: lib/Net/SNMP.pm version: v6.0.1 Net::SNMP::Dispatcher: file: lib/Net/SNMP/Dispatcher.pm version: v4.0.1 Net::SNMP::Message: file: lib/Net/SNMP/Message.pm version: v3.0.1 Net::SNMP::MessageProcessing: file: lib/Net/SNMP/MessageProcessing.pm version: v3.0.1 Net::SNMP::PDU: file: lib/Net/SNMP/PDU.pm version: v3.0.1 Net::SNMP::Security: file: lib/Net/SNMP/Security.pm version: v2.0.0 Net::SNMP::Security::Community: file: lib/Net/SNMP/Security/Community.pm version: v2.0.0 Net::SNMP::Security::USM: file: lib/Net/SNMP/Security/USM.pm version: v4.0.1 Net::SNMP::Transport: file: lib/Net/SNMP/Transport.pm version: v3.0.0 Net::SNMP::Transport::IPv4: file: lib/Net/SNMP/Transport/IPv4.pm version: v1.0.0 Net::SNMP::Transport::IPv4::TCP: file: lib/Net/SNMP/Transport/IPv4/TCP.pm version: v3.0.0 Net::SNMP::Transport::IPv4::UDP: file: lib/Net/SNMP/Transport/IPv4/UDP.pm version: v4.0.0 Net::SNMP::Transport::IPv6: file: lib/Net/SNMP/Transport/IPv6.pm version: v1.0.0 Net::SNMP::Transport::IPv6::TCP: file: lib/Net/SNMP/Transport/IPv6/TCP.pm version: v3.0.0 Net::SNMP::Transport::IPv6::UDP: file: lib/Net/SNMP/Transport/IPv6/UDP.pm version: v3.0.0 recommends: Crypt::DES: 2.03 Crypt::Rijndael: 1.02 Digest::HMAC: 1.00 Digest::MD5: 2.11 Digest::SHA1: 1.02 Socket6: 0.23 requires: Carp: 0 Errno: 0 Exporter: 0 IO::Socket: 0 Math::BigInt: 0 perl: 5.006 resources: CPANForum: http://www.cpanforum.com/dist/Net-SNMP bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SNMP license: http://dev.perl.org/licenses/ version: v6.0.1 Net-SNMP-v6.0.1/t/0000755000175000017500000000000011442272645012527 5ustar dtowndtownNet-SNMP-v6.0.1/t/dsp.t0000444000175000017500000000662311442272645013507 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: dsp.t,v 6.1 2010/09/10 00:01:22 dtown Rel $ # Test of the Net::SNMP Dispatcher and Transport Domain objects. # Copyright (c) 2009 David M. Town . # 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 Test; BEGIN { $| = 1; $^W = 1; plan tests => 15 } use Net::SNMP::Dispatcher; use Net::SNMP::Transport; # # 1. Create transmit and receive Transport Domain objects # my ($r, $tr, $ts) = (100); eval { while ((!defined $tr || !defined $ts) && $r-- > 0) { my $p = (int rand(65535 - 1025)) + 1025; $tr = Net::SNMP::Transport->new(-localport => $p); $ts = Net::SNMP::Transport->new(-port => $p); } }; ok( defined $tr && defined $ts, 1, 'Failed to create Net::SNMP::Transport objects' ); # # 2. Get the Dispatcher instance # my $d; eval { $d = Net::SNMP::Dispatcher->instance(); }; ok(defined $d, 1, 'Failed to get the Net::SNMP::Dispatcher instance'); # # 3. Register the receive Transport Domain object # eval { $r = $d->register($tr, [\&trans_recv]); }; ok($r, $tr, 'Failed to register receive transport - trans_recv()'); # # 4. Schedule timer test 1 - timer_test() # eval { $r = $d->schedule(1, [\&timer_test, 1, time]); }; ok(defined $r, 1, 'Failed to schedule timer test 1 - timer_test()'); # # 5. Schedule timer test 2 - timer_test() # eval { $r = $d->schedule(2, [\&timer_test, 2, time]); }; ok(defined $r, 1, 'Failed to schedule timer test 2 - timer_test()'); # # 6. Schedule timer test 3 - trans_send() # eval { $r = $d->schedule(3, [\&trans_send, 3, time, $ts]); }; ok(defined $r, 1, 'Failed to schedule timer test 3 - trans_send()'); # # 7. Schedule timer test 4 - trans_dereg() # eval { $r = $d->schedule(4, [\&trans_dereg, 4, time, $tr]); }; ok(defined $r, 1, 'Failed to schedule timer test 4 - trans_dereg()'); $d->loop(); exit 0; # # 8. - 9. Validate that timer tests 1 and 2 executed within 1 second tolerence # sub timer_check { my ($c, $s) = @_; my $d = time - $s; return (($d >= $c - 1) && ($d <= $c + 1)) ? $c : $d; } sub timer_test { my ($d, $c, $s) = @_; ok(timer_check($c, $s), $c, "timer_test(): Timer test $c failed"); return; } # # 10. - 11. Validate timer test 3 and Net::SNMP::Transport->send() # sub trans_send { my ($d, $c, $s, $t) = @_; ok(timer_check($c, $s), $c, "trans_send(): Timer test $c failed"); $c = $t->send(' '); ok($c, 1, 'trans_send(): Transport send() failed'); return; } # # 12. - 13. Validate the transport registration and transport recv() # sub trans_recv { my ($d, $t) = @_; ok(defined $t, 1, 'trans_recv(): Transport registration failed'); my $b; my $c = $t->recv($b, 10, 0); ok(defined $c, 1, 'trans_recv(): Transport recv() failed'); return; } # # 14. - 15. Validate timer test 4 and transport deregistration # sub trans_dereg { my ($d, $c, $s, $t) = @_; ok(timer_check($c, $s), $c, "trans_dereg(): Timer test $c failed"); $c = $d->deregister($t); ok($c, $t, 'trans_dereg(): Failed to deregister receive transport'); return; } # ============================================================================ Net-SNMP-v6.0.1/t/mp.t0000444000175000017500000000410611442272645013327 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: mp.t,v 6.0 2009/09/09 15:07:49 dtown Rel $ # Test of the Message Processing Model. # Copyright (c) 2001-2009 David M. Town . # 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 Test; BEGIN { $| = 1; $^W = 1; plan tests => 7 } use Net::SNMP::MessageProcessing; use Net::SNMP::PDU qw( OCTET_STRING SNMP_VERSION_2C ); use Net::SNMP::Security; use Net::SNMP::Transport; # # 1. Get the Message Processing instance # my $m; eval { $m = Net::SNMP::MessageProcessing->instance(); }; ok(defined $m, 1, 'Failed to get Net::SNMP::MessageProcessing instance'); # # 2. Create a Security object # my ($s, $e); eval { ($s, $e) = Net::SNMP::Security->new(-version => SNMP_VERSION_2C); }; ok(($@ || $e), q{}, 'Failed to create Net::SNMP::Security object'); # # 3. Create a Transport Layer object # my $t; eval { ($t, $e) = Net::SNMP::Transport->new(); }; ok(($@ || $e), q{}, 'Failed to create Net::SNMP::Transport object'); # # 4. Create a PDU object # my $p; eval { ($p, $e) = Net::SNMP::PDU->new( -version => SNMP_VERSION_2C, -transport => $t, -security => $s, ); }; ok(($@ || $e), q{}, 'Failed to create Net::SNMP::PDU object'); # # 5. Prepare the PDU # eval { $p->prepare_set_request(['1.3.6.1.2.1.1.4.0', OCTET_STRING, 'dtown']); $e = $p->error(); }; ok(($@ || $e), q{}, 'Failed to prepare set-request'); # # 6. Prepare the Message # eval { $p = $m->prepare_outgoing_msg($p); $e = $m->error(); }; ok(($@ || $e), q{}, 'Failed to prepare Message'); # # 7. Process the message (should get error) # eval { $m->prepare_data_elements($p); $e = $m->error(); }; ok(($@ || $e), qr/expected/i, 'Failed to process Message'); # ============================================================================ Net-SNMP-v6.0.1/t/usm.t0000444000175000017500000001073511442272645013524 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: usm.t,v 6.0 2009/09/09 15:07:49 dtown Rel $ # Test of the SNMPv3 User-based Security Model. # Copyright (c) 2001-2009 David M. Town . # 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 Test; BEGIN { $| = 1; $^W = 1; plan tests => 14 } use Net::SNMP::Message qw(SEQUENCE OCTET_STRING FALSE); # # Load the Net::SNMP::Security::USM module # eval 'use Net::SNMP::Security::USM'; my $skip = ($@ =~ /locate (:?\S+\.pm)/) ? $@ : FALSE; # # 1. Create the Net::SNMP::Security::USM object # my ($u, $e); eval { ($u, $e) = Net::SNMP::Security::USM->new( -username => 'dtown', -authpassword => 'maplesyrup', -privpassword => 'maplesyrup', -privprotocol => 'des', ); # "Perform" discovery... $u->_engine_id_discovery(pack 'x11H2', '02'); # ...and synchronization $u->_synchronize(10, time); }; skip( $skip, ($@ || $e), q{}, 'Failed to create Net::SNMP::Security::USM object' ); # # 2. Check the localized authKey # eval { $e = unpack 'H*', $u->auth_key(); }; skip( $skip, ($@ || $e), '526f5eed9fcce26f8964c2930787d82b', # RFC 3414 - A.3.1 'Invalid authKey calculated' ); # # 3. Check the localized privKey # eval { $e = unpack 'H*', $u->priv_key(); }; skip( $skip, ($@ || $e), '526f5eed9fcce26f8964c2930787d82b', 'Invalid privKey calculated' ); # # 4. Create and initalize a Message # my $m; eval { ($m, $e) = Net::SNMP::Message->new(); $m->prepare(SEQUENCE, pack('H*', 'deadbeef') x 8); $e = $m->error(); }; skip($skip, ($@ || $e), q{}, 'Failed to create Net::SNMP::Message object'); # # 5. Calculate the HMAC # my $h; eval { $h = unpack 'H*', $u->_auth_hmac($m); }; skip($skip, $@, q{}, 'Calculate the HMAC failed'); # # 6. Encrypt/descrypt the Message # eval { my $salt; my $len = $m->length(); my $buff = $m->clear(); $m->append($u->_encrypt_data($m, $salt, $buff)); $u->_decrypt_data($m, $salt, $m->process(OCTET_STRING)); $e = $u->error(); # Remove padding if necessary if ($len -= $m->length()) { substr ${$m->reference()}, $len, -$len, q{}; } }; skip($skip, ($@ || $e), q{}, 'Privacy failed'); # # 7. Check the HMAC # my $h2; eval { $h2 = unpack 'H*', $u->_auth_hmac($m); }; skip($skip, ($@ || $h2), $h, 'Authentication failed'); # # 8. Create the Net::SNMP::Security::USM object # eval { ($u, $e) = Net::SNMP::Security::USM->new( -username => 'dtown', -authpassword => 'maplesyrup', -authprotocol => 'sha', -privpassword => 'maplesyrup', -privprotocol => 'des', ); # "Perform" discovery... $u->_engine_id_discovery(pack 'x11H2', '02'); # ...and synchronization $u->_synchronize(10, time); }; skip( $skip, ($@ || $e), q{}, 'Failed to create Net::SNMP::Security::USM object' ); # # 9. Check the localized authKey # eval { $e = unpack 'H*', $u->auth_key(); }; skip( $skip, ($@ || $e), '6695febc9288e36282235fc7151f128497b38f3f', # RFC 3414 - A.3.2 'Invalid authKey calculated' ); # # 10. Check the localized privKey # eval { $e = unpack 'H*', $u->priv_key(); }; skip( $skip, ($@ || $e), '6695febc9288e36282235fc7151f1284', 'Invalid privKey calculated' ); # # 11. Create and initalize a Message # eval { ($m, $e) = Net::SNMP::Message->new(); $m->prepare(SEQUENCE, pack('H*', 'deadbeef') x 8); $e = $m->error(); }; skip($skip, ($@ || $e), q{}, 'Failed to create Net::SNMP::Message object'); # # 12. Calculate the HMAC # eval { $h = unpack 'H*', $u->_auth_hmac($m); }; skip($skip, $@, q{}, 'Calculate the HMAC failed'); # # 13. Encrypt/descrypt the Message # eval { my $salt; my $len = $m->length(); my $buff = $m->clear(); $m->append($u->_encrypt_data($m, $salt, $buff)); $u->_decrypt_data($m, $salt, $m->process(OCTET_STRING)); $e = $u->error(); # Remove padding if necessary if ($len -= $m->length()) { substr ${$m->reference()}, $len, -$len, q{}; } }; skip($skip, ($@ || $e), q{}, 'Privacy failed'); # # 14. Check the HMAC # eval { $h2 = unpack 'H*', $u->_auth_hmac($m); }; skip($skip, ($@ || $h2), $h, 'Authentication failed'); # ============================================================================ Net-SNMP-v6.0.1/t/ber.t0000444000175000017500000000455211442272645013470 0ustar dtowndtown# -*- mode: perl -*- # ============================================================================ # $Id: ber.t,v 6.0 2009/09/09 15:07:48 dtown Rel $ # Test of the Basic Encoding Rules used by SNMP. # Copyright (c) 2001-2009 David M. Town . # 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 Test; BEGIN { $| = 1; $^W = 1; plan tests => 7 } use Net::SNMP::Message qw(:types SNMP_VERSION_2C TRANSLATE_OCTET_STRING); # # 1. Create a Net::SNMP::Message object # my ($m, $e); eval { ($m, $e) = Net::SNMP::Message->new(-version => SNMP_VERSION_2C); }; ok(($@ || $e), q{}, 'Failed to create Net::SNMP::Message object'); # # 2. Validate INTEGER = 4294967295 # eval { $m->prepare(INTEGER, 4294967295); $e = $m->process() || $m->error(); }; ok(($@ || $e), 4294967295, 'Failed to properly handle INTEGER'); # # 3. Validate INTEGER = -128 # eval { $m->clear(); $m->prepare(INTEGER, -128); $e = $m->process() || $m->error(); }; ok(($@ || $e), -128, 'Failed to properly handle INTEGER'); # # 4. Validate OCTET STRING = 'David M. Town' # eval { $m->clear(); $m->prepare(OCTET_STRING, 'David M. Town'); $e = $m->process() || $m->error(); }; ok(($@ || $e), 'David M. Town', 'Failed to properly handle OCTET STRING'); # # 5. Validate OCTET STRING = 0xdeadbeef # eval { $m->clear(); $m->translate(TRANSLATE_OCTET_STRING); $m->prepare(OCTET_STRING, pack 'H*', 'deadbeef'); $e = $m->process() || $m->error(); }; ok(($@ || $e), '0xdeadbeef', 'Failed to properly handle OCTET STRING'); # # 6. Validate OBJECT IDENTIFIER = '.1.3.6.1.3.4294967295.365.0.1' # eval { $m->clear(); $m->prepare(OBJECT_IDENTIFIER, '.1.3.6.1.3.4294967295.365.0.1'); $e = $m->process || $m->error(); }; ok( ($@ || $e), '.1.3.6.1.3.4294967295.365.0.1', 'Failed to properly handle OBJECT IDENTIFIER' ); # # 7. Validate Counter64 = 18446744073709551615 # eval { $m->clear(); $m->prepare(COUNTER64, '18446744073709551615'); $e = $m->process() || $m->error(); }; ok(($@ || $e), '18446744073709551615', 'Failed to properly handle Counter64'); # ============================================================================ init/snmpmon/ff.sh0000644000000000000000000000104612421715254013141 0ustar rootroot#!/bin/sh tar -zxvf snmpmon.tgz perl -MNet::SNMP -e "use Net::SNMP" > /dev/null 2>&1 if [ $? -ne 0 ]; then tar -xvf Net-SNMP-v6.0.1.tar cd Net-SNMP-v6.0.1 perl Makefile.PL make make install cd .. rm -rf Net-SNMP-v6.0.1 fi mv -f sysmon.pl /data/scripts mv -f snmp_module.pl /etc/snmp echo '*/3 * * * * root /usr/bin/perl /data/scripts/sysmon.pl > /dev/null &' > /etc/cron.d/cibn-sysmon grep -v 'sys_info.sh' /var/spool/cron/root > /tmp/root mv /tmp/root /var/spool/cron/root chmod 600 /var/spool/cron/root service snmpd restart service crond restart init/procmon.conf0000644000000000000000000000012312362152000013026 0ustar rootroot pid /var/run/snmptrapd.pid /usr/sbin/snmpd pid /var/run/ntpd.pid /etc/init.d/ntpd init/init.sh0000644000000000000000000000105612737600511012022 0ustar rootroot#!/bin/bash yum install perl.x86_64 -y yum install net-snmp -y yum install perl-ExtUtils-Embed -y #procmon cd /root/init chmod +x procmon.sh mkdir -pv /data/scripts/procmon cp /root/init/procmon.conf procmon.sh /data/scripts/procmon/ echo "procmon is ok!" #snmpd rm -rf /etc/snmp/snmpd.conf cp /root/init/snmpd.conf /etc/snmp/ echo "snmpd is ok!" chkconfig snmpd on #sysctl.conf rm -rf /etc/sysctl.conf cp /root/init/sysctl.conf /etc/ /sbin/sysctl -p echo "sysctl is ok!" #snmpmon mkdir -pv /data/logs cd /root/init/snmpmon sh ff.sh echo "snmpmon is ok" init/offinit0000644000000000000000000000022312502473362012101 0ustar rootrootxinetd rpcbind rpcgssd rpcidmapd cups fcoe fcoe-target abrtd abrt-ccpp ip6tables lldpad pcscd portreserve dsm_om_connsvc dsm_om_shrsvc dsm_sa_ipmi init/snmpd.conf0000644000000000000000000000113512702575266012523 0ustar rootrootcom2sec notConfigUser 211.151.228.41 VSJPg7Gpm0Z08hbR com2sec notConfigUser 124.251.19.217 VSJPg7Gpm0Z08hbR com2sec notConfigUser 10.12.81.217 VSJPg7Gpm0Z08hbR group notConfigGroup v1 notConfigUser group notConfigGroup v2c notConfigUser view all included .1 smuxpeer .1.3.6.1.4.1.674.10892.1 access notConfigGroup "" any noauth exact all none none syslocation Unknown (edit /etc/snmp/snmpd.conf) syscontact Root (configure /etc/snmp/snmp.local.conf) dontLogTCPWrappersConnects yes perl do "/etc/snmp/snmp_module.pl"