snmp.pm

开发snmp的开发包有两个开放的SNMP开发库

# SNMP.pm -- Perl 5 interface to the Net-SNMP toolkit
#
# written by G. S. Marzot ([e-mail])
#
#     Copyright (c) 1995-2006 G. S. Marzot. All rights reserved.
#     This program is free software; you can redistribute it and/or
#     modify it under the same terms as Perl itself.

package SNMP;
$VERSION = '5.0401';   # current release version number

require Exporter;
require DynaLoader;
require AutoLoader;

use NetSNMP::default_store (':all');

@SNMP::ISA = qw(Exporter AutoLoader DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@SNMP::EXPORT = qw(
	RECEIVED_MESSAGE
	SNMPERR_BAD_ADDRESS
	SNMPERR_BAD_LOCPORT
	SNMPERR_BAD_SESSION
	SNMPERR_GENERR
	SNMPERR_TOO_LONG
	SNMP_DEFAULT_ADDRESS
	SNMP_DEFAULT_COMMUNITY_LEN
	SNMP_DEFAULT_ENTERPRISE_LENGTH
	SNMP_DEFAULT_ERRINDEX
	SNMP_DEFAULT_ERRSTAT
	SNMP_DEFAULT_PEERNAME
	SNMP_DEFAULT_REMPORT
	SNMP_DEFAULT_REQID
	SNMP_DEFAULT_RETRIES
	SNMP_DEFAULT_TIME
	SNMP_DEFAULT_TIMEOUT
	SNMP_DEFAULT_VERSION
	TIMED_OUT
	snmp_get
        snmp_getnext
        snmp_set
        snmp_trap
);

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.
    my($val,$pack,$file,$line);
    local($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    # croak "&$module::constant not defined" if $constname eq 'constant';
    $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
	    ($pack,$file,$line) = caller;
	    die "Your vendor has not defined SNMP macro $constname, used at $file line $line.
";
	}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

bootstrap SNMP;

# Preloaded methods go here.

# Package variables
tie $SNMP::debugging, SNMP::DEBUGGING;
tie $SNMP::debug_internals, SNMP::DEBUG_INTERNALS;
tie $SNMP::dump_packet, SNMP::DUMP_PACKET;
tie %SNMP::MIB, SNMP::MIB;
tie $SNMP::save_descriptions, SNMP::MIB::SAVE_DESCR;
tie $SNMP::replace_newer, SNMP::MIB::REPLACE_NEWER;
tie $SNMP::mib_options, SNMP::MIB::MIB_OPTIONS;

%SNMP::V3_SEC_LEVEL_MAP = (noAuthNoPriv => 1, authNoPriv => 2, authPriv =>3);

$auto_init_mib = 1; # enable automatic MIB loading at session creation time
$use_long_names = 0; # non-zero to prefer longer mib textual identifiers rather
                   # than just leaf indentifiers (see translateObj)
                   # may also be set on a per session basis(see UseLongNames)
$use_sprint_value = 0; # non-zero to enable formatting of response values
                   # using the snmp libraries "snprint_value"
                   # may also be set on a per session basis(see UseSprintValue)
                   # note: returned values not suitable for 'set' operations
$use_enums = 0; # non-zero to return integers as enums and allow sets
                # using enums where appropriate - integer data will
                # still be accepted for set operations
                # may also be set on a per session basis (see UseEnums)
$use_numeric = 0; # non-zero to return object tags as numeric OID's instead
                  # of converting to textual representations.  use_long_names,
                  # if non-zero, returns the entire OID, otherwise, return just
                  # the label portion.  use_long_names is also set if the
		  # use_numeric variable is set.
%MIB = ();      # tied hash to access libraries internal mib tree structure
                # parsed in from mib files
$verbose = 0;   # controls warning/info output of SNMP module,
                # 0 => no output, 1 => enables warning and info
                # output from SNMP module itself (is also controlled
                # by SNMP::debugging)
$debugging = 0; # non-zero to globally enable libsnmp do_debugging output
                # set to >= 2 to enabling packet dumping (see below)
$dump_packet = 0; # non-zero to globally enable libsnmp dump_packet output.
                  # is also enabled when $debugging >= 2
$save_descriptions = 0; #tied scalar to control saving descriptions during
               # mib parsing - must be set prior to mib loading
$best_guess = 0;  # determine whether or not to enable best-guess regular
                  # expression object name translation.  1 = Regex (-Ib),
		  # 2 = random (-IR)
$non_increasing = 0; # stop polling with an "OID not increasing"-error
                     # when an OID does not increases in bulkwalk.
$replace_newer = 0; # determine whether or not to tell the parser to replace
                    # older MIB modules with newer ones when loading MIBs.
                    # WARNING: This can cause an incorrect hierarchy.

sub setMib {
# loads mib from file name provided
# setting second arg to true causes currently loaded mib to be replaced
# otherwise mib file will be added to existing loaded mib database
# NOTE: now deprecated in favor of addMibFiles and new module based funcs
   my $file = shift;
   my $force = shift || '0';
   return 0 if $file and not (-r $file);
   SNMP::_read_mib($file,$force);
}

sub initMib {
# eqivalent to calling the snmp library init_mib if Mib is NULL
# if Mib is already loaded this function does nothing
# Pass a zero valued argument to get minimal mib tree initialzation
# If non zero agrgument or no argument then full mib initialization

  SNMP::init_snmp("perl");
  return;


  if (defined $_[0] and $_[0] == 0) {
    SNMP::_init_mib_internals();
  } else {
    SNMP::_read_mib("");
  }
}

sub addMibDirs {
# adds directories to search path when a module is requested to be loaded
  SNMP::init_snmp("perl");
  foreach (@_) {
    SNMP::_add_mib_dir($_) or return undef;
  }
  return 1;
}

sub addMibFiles {
# adds mib definitions to currently loaded mib database from
# file(s) supplied
  SNMP::init_snmp("perl");
  foreach (@_) {
    SNMP::_read_mib($_) or return undef;
  }
  return 1;
}

sub loadModules {
# adds mib module definitions to currently loaded mib database.
# Modules will be searched from previously defined mib search dirs
# Passing and arg of 'ALL' will cause all known modules to be loaded
   SNMP::init_snmp("perl");
   foreach (@_) {
     SNMP::_read_module($_) or return undef;
   }
   return 1;
}

sub unloadModules {
# causes modules to be unloaded from mib database
# Passing and arg of 'ALL' will cause all known modules to be unloaded
  warn("SNMP::unloadModules not implemented! (yet)");
}

sub translateObj {
# Translate object identifier(tag or numeric) into alternate representation
# (i.e., sysDescr => '.1.3.6.1.2.1.1.1' and '.1.3.6.1.2.1.1.1' => sysDescr)
# when $SNMP::use_long_names or second arg is non-zero the translation will
# return longer textual identifiers (e.g., system.sysDescr).  An optional 
# third argument of non-zero will cause the module name to be prepended
# to the text name (e.g. 'SNMPv2-MIB::sysDescr').  If no Mib is loaded 
# when called and $SNMP::auto_init_mib is enabled then the Mib will be 
# loaded. Will return 'undef' upon failure.
   SNMP::init_snmp("perl");
   my $obj = shift;
   my $temp = shift;
   my $include_module_name = shift || "0";
   my $long_names = $temp || $SNMP::use_long_names;

   return undef if not defined $obj;
   my $res;
   if ($obj =~ /^\.?(\d+\.)*\d+$/) {
      $res = SNMP::_translate_obj($obj,1,$long_names,$SNMP::auto_init_mib,0,$include_module_name);
   } elsif ($obj =~ /(\.\d+)*$/ && $SNMP::best_guess == 0) {
      $res = SNMP::_translate_obj($`,0,$long_names,$SNMP::auto_init_mib,0,$include_module_name);
      $res .= $& if defined $res and defined $&;
   } elsif ($SNMP::best_guess) {
      $res = SNMP::_translate_obj($obj,0,$long_names,$SNMP::auto_init_mib,$SNMP::best_guess,$include_module_name);
   }

   return($res);
}

sub getType {
# return SNMP data type for given textual identifier
# OBJECTID, OCTETSTR, INTEGER, NETADDR, IPADDR, COUNTER
# GAUGE, TIMETICKS, OPAQUE, or undef
  my $tag = shift;
  SNMP::_get_type($tag, $SNMP::best_guess);
}

sub mapEnum {
# return the corresponding integer value *or* tag for a given MIB attribute
# and value. The function will sense which direction to perform the conversion
# various arg formats are supported
#    $val = SNMP::mapEnum($varbind); # note: will update $varbind
#    $val = SNMP::mapEnum('ipForwarding', 'forwarding');
#    $val = SNMP::mapEnum('ipForwarding', 1);
#
  my $var = shift;
  my ($tag, $val, $update);
  if (ref($var) =~ /ARRAY/ or ref($var) =~ /Varbind/) {
      $tag = $var->[$SNMP::Varbind::tag_f];
      $val = $var->[$SNMP::Varbind::val_f];
      $update = 1;
  } else {
      $tag = $var;
      $val = shift;
  }
  my $iflag = $val =~ /^\d+$/;
  my $res = SNMP::_map_enum($tag, $val, $iflag, $SNMP::best_guess);
  if ($update and defined $res) { $var->[$SNMP::Varbind::val_f] = $res; }
  return($res);
}

%session_params = (DestHost => 1,
		   Community => 1,
		   Version => 1,
		   Timeout => 1,
		   Retries => 1,
		   RemotePort => 1,
                   LocalPort => 1);

sub strip_session_params {
    my @params;
    my @args;
    my $param;
    while ($param = shift) {
	push(@params,$param, shift), next
	    if $session_params{$param};
	push(@args,$param);
    }
    @_ = @args;
    @params;
}


sub snmp_get {
# procedural form of 'get' method. sometimes quicker to code
# but is less efficient since the Session is created and destroyed
# with each call. Takes all the parameters of both SNMP::Session::new and
# SNMP::Session::get (*NOTE*: this api does not support async callbacks)

    my @sess_params = &strip_session_params;
    my $sess = new SNMP::Session(@sess_params);

    $sess->get(@_);
}

sub snmp_getnext {
# procedural form of 'getnext' method. sometimes quicker to code
# but is less efficient since the Session is created and destroyed
# with each call. Takes all the parameters of both SNMP::Session::new and
# SNMP::Session::getnext (*NOTE*: this api does not support async callbacks)

    my @sess_params = &strip_session_params;
    my $sess = new SNMP::Session(@sess_params);

    $sess->getnext(@_);
}

sub snmp_set {
# procedural form of 'set' method. sometimes quicker to code
# but is less efficient since the Session is created and destroyed
# with each call. Takes all the parameters of both SNMP::Session::new and
# SNMP::Session::set (*NOTE*: this api does not support async callbacks)

    my @sess_params = &strip_session_params;
    my $sess = new SNMP::Session(@sess_params);

    $sess->set(@_);
}

sub snmp_trap {
# procedural form of 'trap' method. sometimes quicker to code
# but is less efficient since the Session is created and destroyed
# with each call. Takes all the parameters of both SNMP::TrapSession::new and
# SNMP::TrapSession::trap

    my @sess_params = &strip_session_params;
    my $sess = new SNMP::TrapSession(@sess_params);

    $sess->trap(@_);
}

sub MainLoop {
    my $time = shift;
    my $callback = shift;
    my $time_sec = ($time ? int $time : 0);
    my $time_usec = ($time ? int(($time-$time_sec)*1000000) : 0);
    SNMP::_main_loop($time_sec,$time_usec,$callback);
}

sub finish {
    SNMP::_mainloop_finish();
}

sub reply_cb {
    # callback function for async snmp calls
    # when triggered, will do a SNMP read on the
    # given fd
    my $fd = shift;
  SNMP::_read_on_fd($fd);
}

sub select_info {
    # retrieves SNMP used fd's and timeout info
    # calculates timeout in fractional seconds
    # ( easy to use with select statement )
    my($block, $to_sec, $to_usec, @fd_set)=SNMP::_get_select_info();
    my $time_sec_dec = ($block? 0 : $to_sec + $to_usec * 1e-6);
    #print "fd's for snmp -> ", @fd_set, "\n";
    #print "block		-> ", $block, "\n";
    #print "timeout_sec	-> ", $to_sec, "\n";
    #print "timeout_usec	-> ", $to_usec, "\n";
    #print "timeout dec	-> ", $time_sec_dec, "\n";
    return ($time_sec_dec,@fd_set);
}

sub check_timeout {
  # check to see if a snmp session
  # timed out, and if so triggers
  # the callback function
  SNMP::_check_timeout();
  # check to see when have to check again
  my($block, $to_sec, $to_usec, @fd_set)=SNMP::_get_select_info();
  my $time_sec_dec = ($block? 0 : $to_sec + $to_usec * 1e-6);
  #print "fd's for snmp -> ", @fd_set, "\n";
  #print "block		-> ", $block, "\n";
  #print "timeout_sec	-> ", $to_sec, "\n";
  #print "timeout_usec	-> ", $to_usec, "\n";
  #print "timeout dec	-> ", $time_sec_dec, "\n";
  return ($time_sec_dec);
}

sub _tie {
# this is a little implementation hack so ActiveState can access pp_tie
# thru perl code. All other environments allow the calling of pp_tie from
# XS code but AS was not exporting it when PERL_OBJECT was used.
#
# short term solution was call this perl func which calls 'tie'
#
# longterm fix is to supply a patch which allows AS to export pp_tie in
# such a way that it can be called from XS code. gsarathy says:
# a patch to util.c is needed to provide access to PL_paddr
# so it is possible to call PL_paddr[OP_TIE] as the compiler does
    tie($_[0],$_[1],$_[2],$_[3]);
}

sub split_vars {
    # This sub holds the regex that is used throughout this module  
    #  to parse the base part of an OID from the IID.
    #  eg: portName.9.30 -> ['portName','9.30'] 
    my $vars = shift;

    # The regex was changed to this simple form by patch 722075 for some reason.
    # Testing shows now (2/05) that it is not needed, and that the long expression 
    # works fine.  AB
    # my ($tag, $iid) = ($vars =~ /^(.*?)\.?(\d+)+$/);
    
    # These following two are the same.  Broken down for easier maintenance
    # my ($tag, $iid) = ($vars =~ /^((?:\.\d+)+|(?:\w+(?:\-*\w+)+))\.?(.*)$/);
    my ($tag, $iid) =
        ($vars =~ /^(               # Capture $1
                    # 1. either this 5.5.5.5
                     (?:\.\d+)+     # for grouping, won't increment $1
                    |
                    # 2. or asdf-asdf-asdf-asdf
                     (?:            # grouping again
                        \w+         # needs some letters followed by
                        (?:\-*\w+)+ #  zero or more dashes, one or more letters
                     )
                    )
                    \.?             # optionally match a dot
                    (.*)            # whatever is left in the string is our iid ($2)
                   $/x
    );
    return [$tag,$iid];
}

package SNMP::Session;

sub new {
   my $type = shift;
   my $this = {};
   my ($name, $aliases, $host_type, $len, $thisaddr);

   SNMP::init_snmp("perl");