SNMP_Session-1.13/0000755000175000017500000000000011111614635013223 5ustar leinenleinenSNMP_Session-1.13/Artistic0000644000175000017500000002072211106124644014733 0ustar leinenleinen Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. SNMP_Session-1.13/MANIFEST0000644000175000017500000000111411106124644014351 0ustar leinenleinenREADME Artistic README.SNMP_util Makefile.PL MANIFEST index.html lib/BER.pm lib/SNMP_Session.pm lib/SNMP_util.pm test/README test/SNMPAgent.pm test/arp test/ber-test.pl test/capturetest.pl test/cisco-cpus test/cisco-memory test/discover test/if-counters.pl test/if-status.pl test/if-to-routes.pl test/iftop test/map-table.pl test/set-test.pl test/snmpwalkh.pl test/sun-find-process test/sun-ps test/test-table.pl test/test.pl test/trap-listener test/trap-send test/walk-intf.pl test/walk-test.pl test/wwwtest META.yml Module meta-data (added by MakeMaker) SNMP_Session-1.13/README0000644000175000017500000002612011106124644014104 0ustar leinenleinen SNMP support for Perl 5 ----------------------- Copyright (c) 1995-2007, Simon Leinen All rights reserved This program is free software; you can redistribute it under the "Artistic License" included in this distribution (file "Artistic"). Author: Simon Leinen Contributors: Tobias Oetiker Matthew Trunnell Andrzej Tobola Dave Rand Heine Peters Yufang HU Philippe Simonet Daniel L. Needles Dan Cox Iouri Pakhomenko Niels Bakker Mike Mitchell Alan Nichols Mike McCauley Andrew W. Elble Paul E. Erkkila Johannes Demel Rik Hoorelbeke Brett T Warden Alistair Mills Bert Driehuis Michael Deegan Jakob Ilves (/IlvJa) Jan Kasprzak Valerio Bontempi Lorenzo Colitti Joerg Kummer Christopher J. Tengi Luc Pauwels Milen Pavlov Andrew Cornford-Matheson Gerry Dalton Jan van Keulen http://www.switch.ch/misc/leinen/snmp/perl/index.html This archive contains Perl 5 modules SNMP_Session.pm and BER.pm, which, when used together, provide rudimentary access to remote SNMP (v1) agents. This module differs from existing SNMP packages in that it is completely stand-alone, i.e. you don't need to have another SNMP package such as Net-SNMP. It is also written entirely in Perl, so you don't have to compile any C modules. It uses the Perl 5 Socket.pm module and should therefore be very portable, even to non-Unix systems. The SNMP operations currently supported are "get", "get-next", and "set", as well as trap generation and reception. For an excellent example of the type of application this is useful for, see Tobias Oetiker's ``mrtg'' (Multi Router Traffic Grapher) tool: Usage ..... The basic usage of these routines works like this: use BER; require 'SNMP_Session.pm'; # Set $host to the name of the host whose SNMP agent you want # to talk to. Set $community to the community name under # which you want to talk to the agent. Set port to the UDP # port on which the agent listens (usually 161). $session = SNMP_Session->open ($host, $community, $port) or die "couldn't open SNMP session to $host"; # Set $oid1, $oid2... to the BER-encoded OIDs of the MIB # variables you want to get. if ($session->get_request_response ($oid1, $oid2, ...)) { ($bindings) = $session->decode_get_response ($session->{pdu_buffer}); while ($bindings ne '') { ($binding,$bindings) = &decode_sequence ($bindings); ($oid,$value) = &decode_by_template ($binding, "%O%@"); print &pretty_print ($oid)," => ", &pretty_print ($value), "\n"; } } else { die "No response from agent on $host"; } Encoding OIDs ............. In order to BER-encode OIDs, you can use the function BER::encode_oid. It takes (a vector of) numeric subids as an argument. For example, use BER; encode_oid (1, 3, 6, 1, 2, 1, 1, 1, 0) will return the BER-encoded OID for the sysDescr.0 (1.3.6.1.2.1.1.1.0) instance of MIB-2. Decoding the results .................... When get_request_response returns success, you must decode the response PDU from the remote agent. The function `decode_get_response' can be used to do this. It takes a get-response PDU, checks its syntax and returns the "bindings" part of the PDU. This is where the remote agent actually returns the values of the variables in your query. You should iterate over the individual bindings in this "bindings" part and extract the value for each variable. In the example above, the returned bindings are simply printed using the BER::pretty_print function. For better readability of the OIDs, you can also use the following idiom, where the %pretty_oids hash maps BER-encoded numerical OIDs to symbolic OIDs. Note that this simple-minded mapping only works for response OIDs that exactly match known OIDs, so it's unsuitable for table walking (where the response OIDs include an additional row index). %ugly_oids = qw(sysDescr.0 1.3.6.1.2.1.1.1.0 sysContact.0 1.3.6.1.2.1.1.4.0); foreach (keys %ugly_oids) { $ugly_oids{$_} = encode_oid (split (/\./, $ugly_oids{$_})); $pretty_oids{$ugly_oids{$_}} = $_; } ... if ($session->get_request_response ($ugly_oids{'sysDescr.0'}, $ugly_oids{'sysContact.0'})) { ($bindings) = $session->decode_get_response ($session->{pdu_buffer}); while ($bindings ne '') { ($binding,$bindings) = &decode_sequence ($bindings); ($oid,$value) = &decode_by_template ($binding, "%O%@"); print $pretty_oids{$oid}," => ", &pretty_print ($value), "\n"; } } ... Set Requests ............ Set requests are generated much like get or getNext requests are, with the exception that you have to specify not just OIDs, but also the values the variables should be set to. Every binding is passed as a reference to a two-element array, the first element being the encoded OID and the second one the encoded value. See the `test/set-test.pl' script for an example, in particular the subroutine `snmpset'. Walking Tables .............. Beginning with version 0.57 of SNMP_Session.pm, there is API support for walking tables. The map_table method can be used for this as follows: sub walk_function ($$$) { my ($index, $val1, $val3) = @_; ... } ... $columns = [$base_oid1, $base_oid3]; $n_rows = $session->map_table ($columns, \&walk_function); The COLUMNS argument must be a reference to a list of OIDs for table columns sharing the same index. The method will traverse the table and call the WALK_FUNCTION for each row. The arguments for these calls will be: * the row index as a partial OID in dotted notation, e.g. "1.3", or "10.0.1.34". * the values of the requested table columns in that row, in BER-encoded form. If you want to use the standard pretty_print subroutine to decode the values, you can use the following idiom: grep (defined $_ && ($_=pretty_print $_), ($val1, $val3)); Sending Traps ............. To send a trap, you have to open an SNMP session to the trap receiver. Usually this is a process listening to UDP port 162 on a network management station. Then you can use the trap_request_send method to encode and send the trap. There is no way to find out whether the trap was actually received at the management station - SNMP traps are fundamentally unreliable. When constructing an SNMPv1 trap, you must provide * the "enterprise" Object Identifier for the entity that generates the trap * your IP address * the generic trap type * the specific trap type * the sysUpTime at the time of trap generation * a sequence (may be empty) of variable bindings further describing the trap. For SNMPv2 traps, you need: * the trap's OID * the sysUpTime at the time of trap generation * the bindings list as above For SNMPv2 traps, the uptime and trap OID are encoded as bindings which are added to the front of the other bindings you provide. Here is a short example: my $trap_receiver = "netman.noc"; my $trap_community = "SNMP_Traps"; my $trap_session = $version eq '1' ? SNMP_Session->open ($trap_receiver, $trap_community, 162) : SNMPv2c_Session->open ($trap_receiver, $trap_community, 162); my $trap_session = SNMP_Session->open ($trap_receiver, $trap_community, 162); my $myIpAddress = ...; my $start_time = time; ... sub link_down_trap ($$) { my ($if_index, $version) = @_; my $genericTrap = 2; # linkDown my $specificTrap = 0; my @ifIndexOID = ( 1,3,6,1,2,1,2,2,1,1 ); my $upTime = int ((time - $start_time) * 100.0); my @myOID = ( 1,3,6,1,4,1,2946,0,8,15 ); warn "Sending trap failed" unless ($version eq '1') ? $trap_session->trap_request_send (encode_oid (@myOID), encode_ip_address ($myIpAddress), encode_int ($genericTrap), encode_int ($specificTrap), encode_timeticks ($upTime), [encode_oid (@ifIndex_OID,$if_index), encode_int ($if_index)], [encode_oid (@ifDescr_OID,$if_index), encode_string ("foo")]) : $trap_session->v2_trap_request_send (\@linkDown_OID, $upTime, [encode_oid (@ifIndex_OID,$if_index), encode_int ($if_index)], [encode_oid (@ifDescr_OID,$if_index), encode_string ("foo")]); } Receiving Traps ............... Since version 0.60, SNMP_Session.pm supports the receipt and decoding of SNMPv1 trap requests. Since version 0.75, SNMPv2 Trap PDUs are also recognized. To receive traps, you have to create a special SNMP session that passively listens on the SNMP trap transport address (usually UDP port 162). Then you can receive traps (actually, SNMPv1 traps, SNMPv2 traps, and SNMPv2 informs) using the receive_trap method and decode them using decode_trap_request. The enterprise, agent, generic, specific and sysUptime return values are only defined for SNMPv1 traps. In SNMPv2 traps and informs, the equivalent information is contained in the bindings. my $trap_session = SNMPv1_Session->open_trap_session () or die "cannot open trap session"; my ($trap, $sender_addr, $sender_port) = $trap_session->receive_trap () or die "cannot receive trap"; my ($community, $enterprise, $agent, $generic, $specific, $sysUptime, $bindings) = $session->decode_trap_request ($trap) or die "cannot decode trap received" ... my ($binding, $oid, $value); while ($bindings ne '') { ($binding,$bindings) = &decode_sequence ($bindings); ($oid, $value) = decode_by_template ("%O%@"); print BER::pretty_oid ($oid)," => ",pretty_print ($value),"\n"; } Future Plans ............ SNMPv3 Support The code could first be restructured to follow the modularization proposed in RFC 2271 (An Architecture for Describing SNMP Management Frameworks). The existing SNMPv1 and SNMPv2c support must somehow be retrofitted to this framework. Later, one could add support for SNMPv3 PDU formats and for user-based security. Higher-Level APIs The current programming interface is very close to the level of SNMP operations and PDUs. For actual management applications, there are probably more convenient interfaces that could be defined. SNMP_Session-1.13/README.SNMP_util0000644000175000017500000003521311106124644015720 0ustar leinenleinen README for SNMP_util.pm Copyright (c) 1998-2002, Mike Mitchell All rights reserved This program is free software; you can redistribute it under the "Artistic License" included in this distribution (file "Artistic"). Author: Mike Mitchell Contributors: Tobias Oetiker Simon Leinen Jeff Allen Johannes Demel Laurent Girod Ian Duplisse I was using Simon Leinen's SNMP tools in various perl scripts, and I found that I was using the same functions over and over. I grouped the common routines into a separate perl module so that I would only have to make changes in one place, rather than track down all the different perl scripts that included the code. The result is the 'SNMP_utils.pm' module. Thanks goes to Tobias Oetiker (tobi@oetiker.ch) of MRTG fame for the basic layout of the functions. The SNMP_utils.pm module contains the functions snmpmapOID(text, OID, [text, OID ...]) snmpMIB_to_OID(filename) snmpLoad_OID_Cache(filename) snmpQueue_MIB_File(filename, [filename]) snmpget(community@host:port:timeout:retries:backoff:version, OID, [OID...]) snmpgetnext(community@host:port:timeout:retries:backoff:version, OID, [OID...]) snmpwalk(community@host:port:timeout:retries:backoff:version, OID, [OID...]) snmpgetbulk(community@host:port:timeout:retries:backoff:version, non_repeat, max_repeat, OID, [OID...]) snmpset(community@host:port:timeout:retries:backoff:version, OID, type, value, [OID, type, value ...]) snmptrap(community@host:port:timeout:retries:backoff:version, enterpriseOID, agent, generalID, specificID, OID, type, value, [OID, type, value ...]) snmpmaptable(community@host:port:timeout:retries:backoff:version, function, OID, [OID...]) snmpmaptable4(community@host:port:timeout:retries:backoff:version, function, max_repetitions, OID, [OID...]) snmpwalkhash(community@host:port:timeout:retries:backoff:version, function, OID, [OID...], [hash ref]) The functions have a small mapping table for commonly used OIDs. The OIDs from RFC1213 (MIB-II) and RFC1315 (Frame Relay) are preloaded. It is much easier to say "ifInOctets.4" instead of "1.3.6.1.2.1.2.2.1.10.4". The snmpmapOID() function will let you add your own entries to the mapping table. It doesn't return anything. Be sure to leave off any instance number from the OID passed to snmpmapOID()! The example above would be &snmpmapOID("ifInOctets", "1.3.6.1.2.1.2.2.1.10"). Don't use &snmpmapOID("ifInOctets.4", "1.3.6.1.2.1.2.2.1.10.4"). The trailing ".4" is interpreted as an instance number, and not the entire OID. The snmpmapOID function will ignore the attempt to add a mapping entry that includes an instance number. The call &snmpmapOID("ifInOctets.four", "1.3.6.1.2.1.2.2.1.10.4") would be accepted, because the text ".four" is interpreted differently than the number 4. The snmpMIB_to_OID() function will open the passed-in MIB file name and read it. It will create text mappings for the appropriate OID number. It returns the number of text mappings added, so a zero or negative return indicates an error. The snmpLoad_OID_Cache() function will open the passed-in file name and read the file. It is expecting lines with a text string in the first column and an OID number in the second column, like ifInOctets 1.3.6.1.2.1.2.2.1.10 ifOutOctets 1.3.6.1.2.1.2.2.1.16 It will add the text to OID mappings in the file to the internal list by calling the "snmpmapOID()" function. This way the extra overhead of parsing a MIB file can be avoided if you have a pre-parsed version of the MIB handy. The snmpQueue_MIB_File() function queues up file names for use by the "snmpMIB_to_OID()" function. If there are filenames passed into "snmpQueue_MIB_File()", when an OID can't be found in the internal table, the queued MIB files are loaded one after another until the OID can be found (or the list is exhausted). This delays the MIB parsing until the OID value is actually needed. A cache file with the looked up text-to-OID mappings is maintained. It's name is "OID_cache.txt", and can be changed by setting the variable $SNMP_util::CacheFile to the name of the file you desire. This cache file is automatically loaded before the queued MIB files are parsed. If the OID is found in the cache file, the MIB file doesn't have to be parsed. The rest of the functions require a hostname/IP address as the first argument. The community string, port number, timeout, retries, backoff, and version parameters are all optional. If the community string isn't specified, "public" is used. If the port number isn't specified, the default value from SNMP_Sesssion.pm (port 161) is used for everything but snmptrap(). snmptrap() uses port 162 as its default. The port parameter was recently augmented to allow the specification of the IP address (or hostname) and port of the machine doing the query in addition to the IP address (or hostname) and port of the machine being queried. Some machines have additional security features that only allow SNMP queries to come from certain IP addresses. If the host doing the query has multiple interface, it may be necessary to specify the interface the query should come from. The port parameter is further broken down into "remote_port!local_address!local_port". Here are some examples: somehost somehost:161 somehost:161!192.168.2.4!4000 use 192.168.2.4 and port 4000 as source somehost:!192.168.2.4 use 192.168.2.4 as source somehost:!!4000 use port 4000 as source Most people will only need to use the first form ("somehost"). The timeout, retries, and backoff parameters default to whatever SNMP_Session.pm uses. For SNMP_Session.pm version 0.83 they are 2 seconds, 5 retries, and a 1.0 backoff factor. The backoff factor is used as a multiplier to increase the timeout after every retry. With a backoff factor of 1.0 the timeout stays the same for every retry. The version parameter defaults to SNMP version 1. Some SNMP values such as 64-bit counters have to be queried using SNMP version 2. Specifying "2" or "2c" as the version parameter will accomplish this. The snmpgetbulk routine is only supported in SNMP version 2 and higher. Several parameters internal to SNMP_Session can be set by passing a hash as the first OID. The keys to the hash are the parameters to modify. Here is a list of parameters and their default values in SNMP_Session version 0.91: 'community' => "public" 'timeout' => 2.0 'retries' => 5 'backoff' => 1.0 'debug' => 0 'default_max_repetitions' => 12 'use_getbulk' => 1 'lenient_source_address_matching' => 1 'lenient_source_port_matching' => 1 Consult the documentation and/or source code for SNMP_Session for further information of these parameters. The snmpget function returns an array with the results of the 'get' operation. The value associated with each OID is returned as a separate value in the array. The snmpgetnext function returns an array with the results of the 'getnext' operation. The OID number is added to the result as a prefix with a colon separator, like '1.3.6.1.2.1.2.2.1.2.1:ethernet' The snmpwalk function returns an array with all the OID numbers and values, like the 'snmpgetnext' function. If only one OID is specified for the walk, only the instance part of the OID number is added as a prefix. If multiple OID are specified for the walk, the entire OID number is added as a prefix. For instance, a walk of just '1.3.6.1.2.1.2.2.1.2' will return values like '1:ethernet', '2:ethernet', '3:fddi'. A walk multiple OIDs will return values like '1.3.6.1.2.1.2.2.1.2.1:ethernet'. The snmpwalk function will use a 'getbulk' query for efficiency if the SNMP version is 2 or higher. The snmpgetbulk function, like the snmpgetnext function, returns an array with the results of the 'getbulk' operation. The OID number is added to the result as a prefix with a colon separator, like '1.3.6.1.2.1.2.2.1.2.1:ethernet' The 'non_repeat' argument is the number of OID arguments that should be retrieved no more than once. The 'max_repeat' argument is the number of times that other variables beyond those specified by the 'non_repeat' argument should be retrieved. The getbulk query is only supported at SNMP version 2 or higher. The snmpset function is passed OID, type, and value triplets. It returns an array with the result of the set. The snmpmaptable function can be used for walking tables. The OID arguments are the columns of the table sharing the same index, and the passed-in function is called once per row. The passed-in function will be given the row index as a partial OID in dotted notation, e.g. "1.3", or "10.0.1.34", and values of the requested table columns in that row. The snmpmaptable4 function is just like snmpmaptable, only the third argument is the number of table rows to request in a single SNMP query. The snmpmaptable function uses the default of 12 rows. The snmpwalkhash acts like snmpwalk, but will call the passed-in function once per returned value. The function is passed a reference to a hash, the hostname, the textual OID, the dotted-numeric OID, the instance, the value, and the textual OID you requested. That function can customize the result you want, in a hash of hashes, so you can extract the value later by hosts, by oid_names, by oid_numbers, by instances... like these: $hash{$host}{$name}{$inst} = $value; $hash{$host}{$oid}{$inst} = $value; $hash{$name}{$inst} = $value; $hash{$oid}{$inst} = $value; $hash{$oid . '.' . $ints} = $value; $hash{$inst} = $value; ... If the last argument to snmpwalkhash is a reference to a hash, that hash reference is passed to the passed-in function instead of a local hash reference. That way your function can look up other objects unrelated to the current invocation of snmpwalkhash. Here is a simple example of using the functions: #! /usr/local/bin/perl5 BEGIN { ### # Finally, SNMPGet fully written in PERL5. # Thanks to Simon Leinen # More on: http://www.switch.ch/misc/leinen/snmp/perl/ #### # There older perls tend to behave peculiar with # large integers ... require 5.004; use SNMP_util "0.89"; } use strict; sub printfun { my($ind, $desc, $phy) = @_; my($a, $b, $c, $d, $e, $f, $mac); ($a, $b, $c, $d, $e, $f) = unpack("C6", $phy); $mac = sprintf("%02x-%02x-%02x-%02x-%02x-%02x", $a, $b, $c, $d, $e, $f); print "interface $ind: MAC $mac $desc\n"; } sub my_hash_with_host { my($h_ref, $host, $name, $oid, $inst, $value, $tree) = @_; $inst =~ s/^\.+//; if ($name =~ /ifPhysAddress/) { my $mac = ''; map { $mac .= sprintf("%02X", $_) } unpack "CCCCCC", $value; $value = $mac; } $h_ref->{$host}->{$name}->{$inst} = $value; } sub main { my($oid, $host, $response, $cont); my($desc, @ret, $nrows); $host = "127.0.0.1"; $cont = "Your Name"; # This snmpmapOID() isn't necessary, as it is already in # the internal map table. It is just an example... &snmpmapOID("ifDescr", "1.3.6.1.2.1.2.2.1.2"); print "Trying 'getnext' on $host\n"; @ret = &snmpgetnext($host, "ifDescr"); foreach $desc (@ret) { ($oid, $desc) = split(':', $desc, 2); print "$oid = $desc\n"; } print "Trying 'getnext' on $host with different timeout and retries\n"; @ret = &snmpgetnext($host, { 'timeout' => 4, 'retries' => 2 }, "ifDescr"); foreach $desc (@ret) { ($oid, $desc) = split(':', $desc, 2); print "$oid = $desc\n"; } print "Trying 'walk' on $host\n"; @ret = &snmpwalk($host, "ifDescr"); foreach $desc (@ret) { ($oid, $desc) = split(':', $desc, 2); print "$oid = $desc\n"; } print "Trying 'walkhash' on $host\n"; my %ret_hash = &snmpwalkhash($host, \&my_hash_with_host, "ifEntry"); foreach $oid (sort keys %{$ret_hash{$host}}) { foreach my $inst (sort { $a <=> $b } keys %{$ret_hash{$host}{$oid}}) { printf("%20s\t: %-15s %3s = %s\n", $host, $oid, $inst, $ret_hash{$host}{$oid}{$inst}); } } print "Trying 'walkhash' on $host, using own hash\n"; my(%myhash); %ret_hash = &snmpwalkhash($host, \&my_hash_with_host, "ifEntry", \%myhash); foreach $oid (sort keys %{$myhash{$host}}) { foreach my $inst (sort { $a <=> $b } keys %{$myhash{$host}{$oid}}) { printf("%20s\t: %-15s %3s = %s\n", $host, $oid, $inst, $myhash{$host}{$oid}{$inst}); } } print "Before set:\n"; $oid = "sysContact"; ($response) = &snmpget($host, $oid); if ($response) { print "GET $oid : $response\n"; } else { warn "$host did not respond to SNMP query\n"; } my $oldContact = $response; print "setting contact to $cont\n"; ($response) = &snmpset("security\@$host", $oid, 'string', $cont); if ($response) { print "SET: $oid : $response\n"; } else { die "$host did not respond to SNMP set\n"; } print "After set:\n"; ($response) = &snmpget($host, $oid); if ($response) { print "GET $oid : $response\n"; } else { die "$host did not respond to SNMP query\n"; } print "Setting contact back to $oldContact\n"; ($response) = &snmpset("security\@$host", $oid, 'string', $oldContact); if ($response) { print "SET: $oid : $response\n"; } else { die "$host did not respond to SNMP set\n"; } print "After 2nd set:\n"; ($response) = &snmpget($host, $oid); if ($response) { print "GET $oid : $response\n"; } else { die "$host did not respond to SNMP query\n"; } print "Walking table of interface description and physical address\n"; $nrows = &snmpmaptable($host, \&printfun, "ifDescr", "ifPhysAddress"); print "walked $nrows rows in the table\n"; } main; exit(0); ----------------------------------------------------- Here is an example using the MIB parsing functions. First create a file with a simple MIB: cat > dummy.mib < SNMP support for Perl 5

SNMP support for Perl 5

Copyright (c) 1995-2008, Simon Leinen
All rights reserved

This program is free software; you can redistribute it under the "Artistic License 2.0" included in this distribution.

Author: Simon Leinen <simon.leinen@switch.ch>

This package contains Perl 5 modules SNMP_Session.pm, BER.pm, and SNMP_util.pm which, when used together, provide rudimentary access to remote SNMP (v1/v2) agents.

Download it from http://www.switch.ch/misc/leinen/snmp/perl/dist/

The library is featured in the book Essential SNMP by Douglas R. Mauro and Kevin J. Schmidt, July 2001, O'Reilly & Associates, ISBN: 0-59600020-0. You can buy it on-line at Amazon.com In Partnerschaft mit Amazon.de.

Features

This module differs from existing SNMP packages in that it is completely stand-alone, i.e. you don't need to have another SNMP package such as Net-SNMP. It is also written entirely in Perl, so you don't have to compile any C modules. It uses the Perl 5 Socket.pm module and should therefore be very portable, even to non-Unix systems.

Note: For the development of new scripts, I strongly recommend to use the higher-level programming interface provided by SNMP_util.pm. Its use is described in README.SNMP_util. The remainder of this page desribes the low-level API in SNMP_Session.pm, which you normally shouldn't use.

The SNMP operations currently supported are "get", "get-next", "get-bulk" and "set", as well as trap generation and reception.

For an excellent example of the type of application this is useful for, see Tobias Oetiker's ``mrtg'' (Multi Router Traffic Grapher) tool. Another application that uses this library is IOG (Input/Output Grapher).

Recent Changes:

For a list of changes, see the changes.html file packaged with this system.

Usage

The basic usage of these routines works like this: 

use BER;
require 'SNMP_Session.pm';

# Set $host to the name of the host whose SNMP agent you want
# to talk to.  Set $community to the community name under
# which you want to talk to the agent.	Set port to the UDP
# port on which the agent listens (usually 161).

$session = SNMP_Session->open ($host, $community, $port)
    or die "couldn't open SNMP session to $host";

# Set $oid1, $oid2... to the BER-encoded OIDs of the MIB
# variables you want to get.

if ($session->get_request_response ($oid1, $oid2, ...)) {
    ($bindings) = $session->decode_get_response ($session->{pdu_buffer});

    while ($bindings ne '') {
	($binding,$bindings) = &decode_sequence ($bindings);
	($oid,$value) = &decode_by_template ($binding, "%O%@");
	print &pretty_print ($oid)," => ", &pretty_print ($value), "\n";
    }
} else {
    die "No response from agent on $host";
}

Encoding OIDs

In order to BER-encode OIDs, you can use the function BER::encode_oid. It takes (a vector of) numeric subids as an argument. For example, 

use BER;
encode_oid (1, 3, 6, 1, 2, 1, 1, 1, 0)

will return the BER-encoded OID for the sysDescr.0 (1.3.6.1.2.1.1.1.0) instance of MIB-2.

Decoding the results

When get_request_response returns success, you must decode the response PDU from the remote agent. The function decode_get_response can be used to do this. It takes a get-response PDU, checks its syntax and returns the bindings part of the PDU. This is where the remote agent actually returns the values of the variables in your query.

You should iterate over the individual bindings in this bindings part and extract the value for each variable. In the example above, the returned bindings are simply printed using the BER::pretty_print function.

For better readability of the OIDs, you can also use the following idiom, where the %pretty_oids hash maps BER-encoded numerical OIDs to symbolic OIDs. Note that this simple-minded mapping only works for response OIDs that exactly match known OIDs, so it's unsuitable for table walking (where the response OIDs include an additional row index). 

%ugly_oids = qw(sysDescr.0	1.3.6.1.2.1.1.1.0
		sysContact.0	1.3.6.1.2.1.1.4.0);
foreach (keys %ugly_oids) {
    $ugly_oids{$_} = encode_oid (split (/\./, $ugly_oids{$_}));
    $pretty_oids{$ugly_oids{$_}} = $_;
}
...
if ($session->get_request_response ($ugly_oids{'sysDescr.0'},
				    $ugly_oids{'sysContact.0'})) {
    ($bindings) = $session->decode_get_response ($session->{pdu_buffer});
    while ($bindings ne '') {
	($binding,$bindings) = &decode_sequence ($bindings);
	($oid,$value) = &decode_by_template ($binding, "%O%@");
	print $pretty_oids{$oid}," => ",
	      &pretty_print ($value), "\n";
    }
} ...

Set Requests

Set requests are generated much like get or getNext requests are, with the exception that you have to specify not just OIDs, but also the values the variables should be set to. Every binding is passed as a reference to a two-element array, the first element being the encoded OID and the second one the encoded value. See the test/set-test.pl script for an example, in particular the subroutine snmpset.

Walking Tables

Beginning with version 0.57 of SNMP_Session.pm, there is API support for walking tables. The map_table method can be used for this as follows: 

sub walk_function ($$$) {
  my ($index, $val1, $val3) = @_;
  ...
}

...
$columns = [$base_oid1, $base_oid3];
$n_rows = $session->map_table ($columns, \&walk_function);

The columns argument must be a reference to a list of OIDs for table columns sharing the same index. The method will traverse the table and call the walk_function for each row. The arguments for these calls will be:

  1. the row index as a partial OID in dotted notation, e.g. "1.3", or "10.0.1.34".
  2. the values of the requested table columns in that row, in BER-encoded form. If you want to use the standard pretty_print subroutine to decode the values, you can use the following idiom: 
      grep (defined $_ && ($_=pretty_print $_), ($val1, $val3));

Walking Tables With get-bulk

Since version 0.67, SNMP_Session uses a different get_table implementation for SNMPv2c_Sessions. This version uses the ``powerful get-bulk operator'' to retrieve many table rows with each request. In general, this will make table walking much faster under SNMPv2c, especially when round-trip times to the agent are long.

There is one difficulty, however: With get-bulk, a management application can specify the maximum number of rows to return in a single response. SNMP_Session.pm provides a new function, map_table_4, in which this maxRepetitions value can be specified explicitly.

For maximum efficiency, it should be set to a value that is one greater than the number of rows in the table. If it is smaller, then map_table will use more request/response cycles than necessary; if it is bigger, the agent will have to compute variable bindings beyond the end of the table (which map_table will throw away).

Of course it is usually impossible to know the size of the table in advance. If you don't specify maxRepetitions when walking a table, then map_table will use a per-session default ($session->default_max_repetitions). The default value for this default is 12.

If you walk a table multiple times, and the size of the table is relatively stable, you should use the return value of map_table (which is the number of rows it has encountered) to compute the next value of maxRepetitions. Remember to add one so that map_table notices when the table is finished!

Note that for really big tables, this doesn't make a big difference, since the table won't fit in a single response packet anyway.

Sending Traps

To send a trap, you have to open an SNMP session to the trap receiver. Usually this is a process listening to UDP port 162 on a network management station. Then you can use the trap_request_send method to encode and send SNMPv1 traps. There is no way to find out whether the trap was actually received at the management station - SNMP traps are fundamentally unreliable.

When constructing an SNMPv1 trap, you must provide

  • the "enterprise" Object Identifier for the entity that generates the trap
  • your IP address
  • the generic trap type
  • the specific trap type
  • the sysUpTime at the time of trap generation
  • a sequence (may be empty) of variable bindings further describing the trap.

For SNMPv2 traps, you need:

  • the trap's OID
  • the sysUpTime at the time of trap generation
  • the bindings list as above

For SNMPv2 traps, the uptime and trap OID are encoded as bindings which are added to the front of the other bindings you provide.

Here is a short example: 

my $trap_receiver = "netman.noc";
my $trap_community = "SNMP_Traps";
my $trap_session = $version eq '1'
    ? SNMP_Session->open ($trap_receiver, $trap_community, 162)
    : SNMPv2c_Session->open ($trap_receiver, $trap_community, 162);
my $myIpAddress = ...;
my $start_time = time;

...

sub link_down_trap ($$) {
  my ($if_index, $version) = @_;
  my $genericTrap = 2;		# linkDown
  my $specificTrap = 0;
  my @ifIndexOID = ( 1,3,6,1,2,1,2,2,1,1 );
  my $upTime = int ((time - $start_time) * 100.0);
  my @myOID = ( 1,3,6,1,4,1,2946,0,8,15 );

  warn "Sending trap failed"
    unless ($version eq '1')
	? $trap_session->trap_request_send (encode_oid (@myOID),
					    encode_ip_address ($myIpAddress),
					    encode_int ($genericTrap),
					    encode_int ($specificTrap),
					    encode_timeticks ($upTime),
					    [encode_oid (@ifIndex_OID,$if_index),
					     encode_int ($if_index)],
					    [encode_oid (@ifDescr_OID,$if_index),
					     encode_string ("foo")])
	    : $trap_session->v2_trap_request_send (\@linkDown_OID, $upTime,
						   [encode_oid (@ifIndex_OID,$if_index),
						    encode_int ($if_index)],
						   [encode_oid (@ifDescr_OID,$if_index),
						    encode_string ("foo")]);
}

Receiving Traps

Since version 0.60, SNMP_Session.pm supports the receipt and decoding of SNMPv1 trap requests. Since version 0.75, SNMPv2 Trap PDUs are also recognized.

To receive traps, you have to create a special SNMP session that passively listens on the SNMP trap transport address (usually UDP port 162). Then you can receive traps (actually, SNMPv1 traps, SNMPv2 traps, and SNMPv2 informs) using the receive_trap method and decode them using decode_trap_request. The enterprise, agent, generic, specific and sysUptime return values are only defined for SNMPv1 traps. In SNMPv2 traps and informs, the equivalent information is contained in the bindings. 

my $trap_session = SNMPv1_Session->open_trap_session ()
  or die "cannot open trap session";
my ($trap, $sender_addr, $sender_port) = $trap_session->receive_trap ()
  or die "cannot receive trap";
my ($community, $enterprise, $agent,
    $generic, $specific, $sysUptime, $bindings)
  = $trap_session->decode_trap_request ($trap)
    or die "cannot decode trap received"
...
my ($binding, $oid, $value);
while ($bindings ne '') {
    ($binding,$bindings) = &decode_sequence ($bindings);
    ($oid, $value) = decode_by_template ($binding, "%O%@");
    print BER::pretty_oid ($oid)," => ",pretty_print ($value),"\n";
}

Future Plans

SNMPv3 Support

The code could first be restructured to follow the modularization proposed in RFC 2271 (An Architecture for Describing SNMP Management Frameworks). The existing SNMPv1 and SNMPv2c support must somehow be retrofitted to this framework. Later, one could add support for SNMPv3 PDU formats and for user-based security.

Higher-Level APIs

The current programming interface is very close to the level of SNMP operations and PDUs. For actual management applications, there are probably more convenient interfaces that could be defined.

20080402 Simon Leinen <simon.leinen@switch.ch> Valid HTML 4.0!
SNMP_Session-1.13/lib/0000755000175000017500000000000011111614635013771 5ustar leinenleinenSNMP_Session-1.13/lib/SNMP_Session.pm0000644000175000017500000010504511111443075016612 0ustar leinenleinen### -*- mode: Perl -*- ###################################################################### ### SNMP Request/Response Handling ###################################################################### ### Copyright (c) 1995-2008, Simon Leinen. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### The abstract class SNMP_Session defines objects that can be used ### to communicate with SNMP entities. It has methods to send ### requests to and receive responses from an agent. ### ### Two instantiable subclasses are defined: ### SNMPv1_Session implements SNMPv1 (RFC 1157) functionality ### SNMPv2c_Session implements community-based SNMPv2. ###################################################################### ### Created by: Simon Leinen ### ### Contributions and fixes by: ### ### Matthew Trunnell ### Tobias Oetiker ### Heine Peters ### Daniel L. Needles ### Mike Mitchell ### Clinton Wong ### Alan Nichols ### Mike McCauley ### Andrew W. Elble ### Brett T Warden : pretty UInteger32 ### Michael Deegan ### Sergio Macedo ### Jakob Ilves (/IlvJa) : PDU capture ### Valerio Bontempi : IPv6 support ### Lorenzo Colitti : IPv6 support ### Philippe Simonet : Export avoid... ### Luc Pauwels : use_16bit_request_ids ### Andrew Cornford-Matheson : inform ### Gerry Dalton : strict subs bug ### Mike Fischer : pass MSG_DONTWAIT to recv() ###################################################################### package SNMP_Session; require 5.002; use strict; use Exporter; use vars qw(@ISA $VERSION @EXPORT $errmsg $suppress_warnings $default_avoid_negative_request_ids $default_use_16bit_request_ids); use Socket; use BER '1.05'; use Carp; sub map_table ($$$ ); sub map_table_4 ($$$$); sub map_table_start_end ($$$$$$); sub index_compare ($$); sub oid_diff ($$); $VERSION = '1.13'; @ISA = qw(Exporter); @EXPORT = qw(errmsg suppress_warnings index_compare oid_diff recycle_socket ipv6available); my $default_debug = 0; ### Default initial timeout (in seconds) waiting for a response PDU ### after a request is sent. Note that when a request is retried, the ### timeout is increased by BACKOFF (see below). ### my $default_timeout = 2.0; ### Default number of attempts to get a reply for an SNMP request. If ### no response is received after TIMEOUT seconds, the request is ### resent and a new response awaited with a longer timeout (see the ### documentation on BACKOFF below). The "retries" value should be at ### least 1, because the first attempt counts, too (the name "retries" ### is confusing, sorry for that). ### my $default_retries = 5; ### Default backoff factor for SNMP_Session objects. This factor is ### used to increase the TIMEOUT every time an SNMP request is ### retried. ### my $default_backoff = 1.0; ### Default value for maxRepetitions. This specifies how many table ### rows are requested in getBulk requests. Used when walking tables ### using getBulk (only available in SNMPv2(c) and later). If this is ### too small, then a table walk will need unnecessarily many ### request/response exchanges. If it is too big, the agent may ### compute many variables after the end of the table. It is ### recommended to set this explicitly for each table walk by using ### map_table_4(). ### my $default_max_repetitions = 12; ### Default value for "avoid_negative_request_ids". ### ### Set this to non-zero if you have agents that have trouble with ### negative request IDs, and don't forget to complain to your agent ### vendor. According to the spec (RFC 1905), the request-id is an ### Integer32, i.e. its range is from -(2^31) to (2^31)-1. However, ### some agents erroneously encode the response ID as an unsigned, ### which prevents this code from matching such responses to requests. ### $SNMP_Session::default_avoid_negative_request_ids = 0; ### Default value for "use_16bit_request_ids". ### ### Set this to non-zero if you have agents that use 16bit request IDs, ### and don't forget to complain to your agent vendor. ### $SNMP_Session::default_use_16bit_request_ids = 0; ### Whether all SNMP_Session objects should share a single UDP socket. ### $SNMP_Session::recycle_socket = 0; ### IPv6 initialization code: check that IPv6 libraries are available, ### and if so load them. ### We store the length of an IPv6 socket address structure in the class ### so we can determine if a socket address is IPv4 or IPv6 just by checking ### its length. The proper way to do this would be to use sockaddr_family(), ### but this function is only available in recent versions of Socket.pm. my $ipv6_addr_len; ### Flags to be passed to recv() when non-blocking behavior is ### desired. On most POSIX-like systems this will be set to ### MSG_DONTWAIT, on other systems we leave it at zero. ### my $dont_wait_flags; BEGIN { $ipv6_addr_len = undef; $SNMP_Session::ipv6available = 0; $dont_wait_flags = 0; if (eval {local $SIG{__DIE__};require Socket6;} && eval {local $SIG{__DIE__};require IO::Socket::INET6; IO::Socket::INET6->VERSION("1.26");}) { import Socket6; $ipv6_addr_len = length(pack_sockaddr_in6(161, inet_pton(AF_INET6(), "::1"))); $SNMP_Session::ipv6available = 1; } eval 'local $SIG{__DIE__};local $SIG{__WARN__};$dont_wait_flags = MSG_DONTWAIT();'; } ### Cache for reusable sockets. This is indexed by socket (address) ### family, so that we don't try to reuse an IPv4 socket for IPv6 or ### vice versa. ### my %the_socket = (); $SNMP_Session::errmsg = ''; $SNMP_Session::suppress_warnings = 0; sub get_request { 0 | context_flag () }; sub getnext_request { 1 | context_flag () }; sub get_response { 2 | context_flag () }; sub set_request { 3 | context_flag () }; sub trap_request { 4 | context_flag () }; sub getbulk_request { 5 | context_flag () }; sub inform_request { 6 | context_flag () }; sub trap2_request { 7 | context_flag () }; sub standard_udp_port { 161 }; sub open { return SNMPv1_Session::open (@_); } sub timeout { $_[0]->{timeout} } sub retries { $_[0]->{retries} } sub backoff { $_[0]->{backoff} } sub set_timeout { my ($session, $timeout) = @_; croak ("timeout ($timeout) must be a positive number") unless $timeout > 0.0; $session->{'timeout'} = $timeout; } sub set_retries { my ($session, $retries) = @_; croak ("retries ($retries) must be a non-negative integer") unless $retries == int ($retries) && $retries >= 0; $session->{'retries'} = $retries; } sub set_backoff { my ($session, $backoff) = @_; croak ("backoff ($backoff) must be a number >= 1.0") unless $backoff == int ($backoff) && $backoff >= 1.0; $session->{'backoff'} = $backoff; } sub encode_request_3 ($$$@) { my($this, $reqtype, $encoded_oids_or_pairs, $i1, $i2) = @_; my($request); local($_); $this->{request_id} = ($this->{request_id} == 0x7fffffff) ? -0x80000000 : $this->{request_id}+1; $this->{request_id} += 0x80000000 if ($this->{avoid_negative_request_ids} && $this->{request_id} < 0); $this->{request_id} &= 0x0000ffff if ($this->{use_16bit_request_ids}); foreach $_ (@{$encoded_oids_or_pairs}) { if (ref ($_) eq 'ARRAY') { $_ = &encode_sequence ($_->[0], $_->[1]) || return $this->ber_error ("encoding pair"); } else { $_ = &encode_sequence ($_, encode_null()) || return $this->ber_error ("encoding value/null pair"); } } $request = encode_tagged_sequence ($reqtype, encode_int ($this->{request_id}), defined $i1 ? encode_int ($i1) : encode_int_0 (), defined $i2 ? encode_int ($i2) : encode_int_0 (), encode_sequence (@{$encoded_oids_or_pairs})) || return $this->ber_error ("encoding request PDU"); return $this->wrap_request ($request); } sub encode_get_request { my($this, @oids) = @_; return encode_request_3 ($this, get_request, \@oids); } sub encode_getnext_request { my($this, @oids) = @_; return encode_request_3 ($this, getnext_request, \@oids); } sub encode_getbulk_request { my($this, $non_repeaters, $max_repetitions, @oids) = @_; return encode_request_3 ($this, getbulk_request, \@oids, $non_repeaters, $max_repetitions); } sub encode_set_request { my($this, @encoded_pairs) = @_; return encode_request_3 ($this, set_request, \@encoded_pairs); } sub encode_trap_request ($$$$$$@) { my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_; my($request); local($_); foreach $_ (@pairs) { if (ref ($_) eq 'ARRAY') { $_ = &encode_sequence ($_->[0], $_->[1]) || return $this->ber_error ("encoding pair"); } else { $_ = &encode_sequence ($_, encode_null()) || return $this->ber_error ("encoding value/null pair"); } } $request = encode_tagged_sequence (trap_request, $ent, $agent, $gen, $spec, $dt, encode_sequence (@pairs)) || return $this->ber_error ("encoding trap PDU"); return $this->wrap_request ($request); } sub encode_v2_trap_request ($@) { my($this, @pairs) = @_; return encode_request_3($this, trap2_request, \@pairs); } sub decode_get_response { my($this, $response) = @_; my @rest; @{$this->{'unwrapped'}}; } sub decode_trap_request ($$) { my ($this, $trap) = @_; my ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt, $request_id, $error_status, $error_index, $bindings); ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt, $bindings) = decode_by_template ($trap, "%{%i%s%*{%O%A%i%i%u%{%@", trap_request); if (!defined $snmp_version) { ($snmp_version, $community, $request_id, $error_status, $error_index, $bindings) = decode_by_template ($trap, "%{%i%s%*{%i%i%i%{%@", trap2_request); if (!defined $snmp_version) { ($snmp_version, $community,$request_id, $error_status, $error_index, $bindings) = decode_by_template ($trap, "%{%i%s%*{%i%i%i%{%@", inform_request); } return $this->error_return ("v2 trap/inform request contained errorStatus/errorIndex " .$error_status."/".$error_index) if defined $error_status && defined $error_index && ($error_status != 0 || $error_index != 0); } if (!defined $snmp_version) { return $this->error_return ("BER error decoding trap:\n ".$BER::errmsg); } return ($community, $ent, $agent, $gen, $spec, $dt, $bindings); } sub wait_for_response { my($this) = shift; my($timeout) = shift || 10.0; my($rin,$win,$ein) = ('','',''); my($rout,$wout,$eout); vec($rin,$this->sockfileno,1) = 1; select($rout=$rin,$wout=$win,$eout=$ein,$timeout); } sub get_request_response ($@) { my($this, @oids) = @_; return $this->request_response_5 ($this->encode_get_request (@oids), get_response, \@oids, 1); } sub set_request_response ($@) { my($this, @pairs) = @_; return $this->request_response_5 ($this->encode_set_request (@pairs), get_response, \@pairs, 1); } sub getnext_request_response ($@) { my($this,@oids) = @_; return $this->request_response_5 ($this->encode_getnext_request (@oids), get_response, \@oids, 1); } sub getbulk_request_response ($$$@) { my($this,$non_repeaters,$max_repetitions,@oids) = @_; return $this->request_response_5 ($this->encode_getbulk_request ($non_repeaters,$max_repetitions,@oids), get_response, \@oids, 1); } sub trap_request_send ($$$$$$@) { my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_; my($req); $req = $this->encode_trap_request ($ent, $agent, $gen, $spec, $dt, @pairs); ## Encoding may have returned an error. return undef unless defined $req; $this->send_query($req) || return $this->error ("send_trap: $!"); return 1; } sub v2_trap_request_send ($$$@) { my($this, $trap_oid, $dt, @pairs) = @_; my @sysUptime_OID = ( 1,3,6,1,2,1,1,3 ); my @snmpTrapOID_OID = ( 1,3,6,1,6,3,1,1,4,1 ); my($req); unshift @pairs, [encode_oid (@snmpTrapOID_OID,0), encode_oid (@{$trap_oid})]; unshift @pairs, [encode_oid (@sysUptime_OID,0), encode_timeticks ($dt)]; $req = $this->encode_v2_trap_request (@pairs); ## Encoding may have returned an error. return undef unless defined $req; $this->send_query($req) || return $this->error ("send_trap: $!"); return 1; } sub request_response_5 ($$$$$) { my ($this, $req, $response_tag, $oids, $errorp) = @_; my $retries = $this->retries; my $timeout = $this->timeout; my ($nfound, $timeleft); ## Encoding may have returned an error. return undef unless defined $req; $timeleft = $timeout; while ($retries > 0) { $this->send_query ($req) || return $this->error ("send_query: $!"); # IlvJa # Add request pdu to capture_buffer push @{$this->{'capture_buffer'}}, $req if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # wait_for_response: ($nfound, $timeleft) = $this->wait_for_response($timeleft); if ($nfound > 0) { my($response_length); $response_length = $this->receive_response_3 ($response_tag, $oids, $errorp, 1); if ($response_length) { # IlvJa # Add response pdu to capture_buffer push (@{$this->{'capture_buffer'}}, substr($this->{'pdu_buffer'}, 0, $response_length) ) if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # return $response_length; } elsif (defined ($response_length)) { goto wait_for_response; # A response has been received, but for a different # request ID or from a different IP address. } else { return undef; } } else { ## No response received - retry --$retries; $timeout *= $this->backoff; $timeleft = $timeout; } } # IlvJa # Add empty packet to capture_buffer push @{$this->{'capture_buffer'}}, "" if (defined $this->{'capture_buffer'} and ref $this->{'capture_buffer'} eq 'ARRAY'); # $this->error ("no response received"); } sub map_table ($$$) { my ($session, $columns, $mapfn) = @_; return $session->map_table_4 ($columns, $mapfn, $session->default_max_repetitions ()); } sub map_table_4 ($$$$) { my ($session, $columns, $mapfn, $max_repetitions) = @_; return $session->map_table_start_end ($columns, $mapfn, "", undef, $max_repetitions); } sub map_table_start_end ($$$$$$) { my ($session, $columns, $mapfn, $start, $end, $max_repetitions) = @_; my @encoded_oids; my $call_counter = 0; my $base_index = $start; do { foreach (@encoded_oids = @{$columns}) { $_=encode_oid (@{$_},split '\.',$base_index) || return $session->ber_error ("encoding OID $base_index"); } if ($session->getnext_request_response (@encoded_oids)) { my $response = $session->pdu_buffer; my ($bindings) = $session->decode_get_response ($response); my $smallest_index = undef; my @collected_values = (); my @bases = @{$columns}; while ($bindings ne '') { my ($binding, $oid, $value); my $base = shift @bases; ($binding, $bindings) = decode_sequence ($bindings); ($oid, $value) = decode_by_template ($binding, "%O%@"); my $out_index; $out_index = &oid_diff ($base, $oid); my $cmp; if (!defined $smallest_index || ($cmp = index_compare ($out_index,$smallest_index)) == -1) { $smallest_index = $out_index; grep ($_=undef, @collected_values); push @collected_values, $value; } elsif ($cmp == 1) { push @collected_values, undef; } else { push @collected_values, $value; } } (++$call_counter, &$mapfn ($smallest_index, @collected_values)) if defined $smallest_index; $base_index = $smallest_index; } else { return undef; } } while (defined $base_index && (!defined $end || index_compare ($base_index, $end) < 0)); $call_counter; } sub index_compare ($$) { my ($i1, $i2) = @_; $i1 = '' unless defined $i1; $i2 = '' unless defined $i2; if ($i1 eq '') { return $i2 eq '' ? 0 : 1; } elsif ($i2 eq '') { return 1; } elsif (!$i1) { return $i2 eq '' ? 1 : !$i2 ? 0 : 1; } elsif (!$i2) { return -1; } else { my ($f1,$r1) = split('\.',$i1,2); my ($f2,$r2) = split('\.',$i2,2); if ($f1 < $f2) { return -1; } elsif ($f1 > $f2) { return 1; } else { return index_compare ($r1,$r2); } } } sub oid_diff ($$) { my($base, $full) = @_; my $base_dotnot = join ('.',@{$base}); my $full_dotnot = BER::pretty_oid ($full); return undef unless substr ($full_dotnot, 0, length $base_dotnot) eq $base_dotnot && substr ($full_dotnot, length $base_dotnot, 1) eq '.'; substr ($full_dotnot, length ($base_dotnot)+1); } # Pretty_address returns a human-readable representation of an IPv4 or IPv6 address. sub pretty_address { my($addr) = shift; my($port, $addrunpack, $addrstr); # Disable strict subs to stop old versions of perl from # complaining about AF_INET6 when Socket6 is not available if( (defined $ipv6_addr_len) && (length $addr == $ipv6_addr_len)) { ($port,$addrunpack) = unpack_sockaddr_in6 ($addr); $addrstr = inet_ntop (AF_INET6(), $addrunpack); } else { ($port,$addrunpack) = unpack_sockaddr_in ($addr); $addrstr = inet_ntoa ($addrunpack); } return sprintf ("[%s].%d", $addrstr, $port); } sub version { $VERSION; } sub error_return ($$) { my ($this,$message) = @_; $SNMP_Session::errmsg = $message; unless ($SNMP_Session::suppress_warnings) { $message =~ s/^/ /mg; carp ("Error:\n".$message."\n"); } return undef; } sub error ($$) { my ($this,$message) = @_; my $session = $this->to_string; $SNMP_Session::errmsg = $message."\n".$session; unless ($SNMP_Session::suppress_warnings) { $session =~ s/^/ /mg; $message =~ s/^/ /mg; carp ("SNMP Error:\n".$SNMP_Session::errmsg."\n"); } return undef; } sub ber_error ($$) { my ($this,$type) = @_; my ($errmsg) = $BER::errmsg; $errmsg =~ s/^/ /mg; return $this->error ("$type:\n$errmsg"); } package SNMPv1_Session; use strict qw(vars subs); # see above use vars qw(@ISA); use SNMP_Session; use Socket; use BER; use IO::Socket; use Carp; BEGIN { if($SNMP_Session::ipv6available) { import IO::Socket::INET6; import Socket6; } } @ISA = qw(SNMP_Session); sub snmp_version { 0 } # Supports both IPv4 and IPv6. # Numeric IPv6 addresses must be passed between square brackets [] sub open { my($this, $remote_hostname,$community,$port, $max_pdu_len,$local_port,$max_repetitions, $local_hostname,$ipv4only) = @_; my($remote_addr,$socket,$sockfamily); $ipv4only = 1 unless defined $ipv4only; $sockfamily = AF_INET; $community = 'public' unless defined $community; $port = SNMP_Session::standard_udp_port unless defined $port; $max_pdu_len = 8000 unless defined $max_pdu_len; $max_repetitions = $default_max_repetitions unless defined $max_repetitions; if ($ipv4only || ! $SNMP_Session::ipv6available) { # IPv4-only code, uses only Socket and INET calls if (defined $remote_hostname) { $remote_addr = inet_aton ($remote_hostname) or return $this->error_return ("can't resolve \"$remote_hostname\" to IP address"); } if ($SNMP_Session::recycle_socket && exists $the_socket{$sockfamily}) { $socket = $the_socket{$sockfamily}; } else { $socket = IO::Socket::INET->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); $the_socket{$sockfamily} = $socket if $SNMP_Session::recycle_socket; } $remote_addr = pack_sockaddr_in ($port, $remote_addr) if defined $remote_addr; } else { # IPv6-capable code. Will use IPv6 or IPv4 depending on the address. # Uses Socket6 and INET6 calls. # If it's a numeric IPv6 addresses, remove square brackets if ($remote_hostname =~ /^\[(.*)\]$/) { $remote_hostname = $1; } my (@res, $socktype_tmp, $proto_tmp, $canonname_tmp); @res = getaddrinfo($remote_hostname, $port, AF_UNSPEC, SOCK_DGRAM); ($sockfamily, $socktype_tmp, $proto_tmp, $remote_addr, $canonname_tmp) = @res; if (scalar(@res) < 5) { return $this->error_return ("can't resolve \"$remote_hostname\" to IPv6 address"); } if ($SNMP_Session::recycle_socket && exists $the_socket{$sockfamily}) { $socket = $the_socket{$sockfamily}; } elsif ($sockfamily == AF_INET) { $socket = IO::Socket::INET->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); } else { $socket = IO::Socket::INET6->new(Proto => 17, Type => SOCK_DGRAM, LocalAddr => $local_hostname, LocalPort => $local_port) || return $this->error_return ("creating socket: $!"); $the_socket{$sockfamily} = $socket if $SNMP_Session::recycle_socket; } } bless { 'sock' => $socket, 'sockfileno' => fileno ($socket), 'community' => $community, 'remote_hostname' => $remote_hostname, 'remote_addr' => $remote_addr, 'sockfamily' => $sockfamily, 'max_pdu_len' => $max_pdu_len, 'pdu_buffer' => '\0' x $max_pdu_len, 'request_id' => (int (rand 0x10000) << 16) + int (rand 0x10000) - 0x80000000, 'timeout' => $default_timeout, 'retries' => $default_retries, 'backoff' => $default_backoff, 'debug' => $default_debug, 'error_status' => 0, 'error_index' => 0, 'default_max_repetitions' => $max_repetitions, 'use_getbulk' => 1, 'lenient_source_address_matching' => 1, 'lenient_source_port_matching' => 1, 'avoid_negative_request_ids' => $SNMP_Session::default_avoid_negative_request_ids, 'use_16bit_request_ids' => $SNMP_Session::default_use_16bit_request_ids, 'capture_buffer' => undef, }; } sub open_trap_session (@) { my ($this, $port) = @_; $port = 162 unless defined $port; return $this->open (undef, "", 161, undef, $port); } sub sock { $_[0]->{sock} } sub sockfileno { $_[0]->{sockfileno} } sub remote_addr { $_[0]->{remote_addr} } sub pdu_buffer { $_[0]->{pdu_buffer} } sub max_pdu_len { $_[0]->{max_pdu_len} } sub default_max_repetitions { defined $_[1] ? $_[0]->{default_max_repetitions} = $_[1] : $_[0]->{default_max_repetitions} } sub debug { defined $_[1] ? $_[0]->{debug} = $_[1] : $_[0]->{debug} } sub close { my($this) = shift; ## Avoid closing the socket if it may be shared with other session ## objects. if (! exists $the_socket{$this->{sockfamily}} or $this->sock ne $the_socket{$this->{sockfamily}}) { close ($this->sock) || $this->error ("close: $!"); } } sub wrap_request { my($this) = shift; my($request) = shift; encode_sequence (encode_int ($this->snmp_version), encode_string ($this->{community}), $request) || return $this->ber_error ("wrapping up request PDU"); } my @error_status_code = qw(noError tooBig noSuchName badValue readOnly genErr noAccess wrongType wrongLength wrongEncoding wrongValue noCreation inconsistentValue resourceUnavailable commitFailed undoFailed authorizationError notWritable inconsistentName); sub unwrap_response_5b { my ($this,$response,$tag,$oids,$errorp) = @_; my ($community,$request_id,@rest,$snmpver); ($snmpver,$community,$request_id, $this->{error_status}, $this->{error_index}, @rest) = decode_by_template ($response, "%{%i%s%*{%i%i%i%{%@", $tag); return $this->ber_error ("Error decoding response PDU") unless defined $snmpver; return $this->error ("Received SNMP response with unknown snmp-version field $snmpver") unless $snmpver == $this->snmp_version; if ($this->{error_status} != 0) { if ($errorp) { my ($oid, $errmsg); $errmsg = $error_status_code[$this->{error_status}] || $this->{error_status}; $oid = $oids->[$this->{error_index}-1] if $this->{error_index} > 0 && $this->{error_index}-1 <= $#{$oids}; $oid = $oid->[0] if ref($oid) eq 'ARRAY'; return ($community, $request_id, $this->error ("Received SNMP response with error code\n" ." error status: $errmsg\n" ." index ".$this->{error_index} .(defined $oid ? " (OID: ".&BER::pretty_oid($oid).")" : ""))); } else { if ($this->{error_index} == 1) { @rest[$this->{error_index}-1..$this->{error_index}] = (); } } } ($community, $request_id, @rest); } sub send_query ($$) { my ($this,$query) = @_; send ($this->sock,$query,0,$this->remote_addr); } ## Compare two sockaddr_in structures for equality. This is used when ## matching incoming responses with outstanding requests. Previous ## versions of the code simply did a bytewise comparison ("eq") of the ## two sockaddr_in structures, but this didn't work on some systems ## where sockaddr_in contains other elements than just the IP address ## and port number, notably FreeBSD. ## ## We allow for varying degrees of leniency when checking the source ## address. By default we now ignore it altogether, because there are ## agents that don't respond from UDP port 161, and there are agents ## that don't respond from the IP address the query had been sent to. ## ## The address family is stored in the session object. We could use ## sockaddr_family() to determine it from the sockaddr, but this function ## is only available in recent versions of Socket.pm. sub sa_equal_p ($$$) { my ($this, $sa1, $sa2) = @_; my ($p1,$a1,$p2,$a2); # Disable strict subs to stop old versions of perl from # complaining about AF_INET6 when Socket6 is not available if($this->{'sockfamily'} == AF_INET) { # IPv4 addresses ($p1,$a1) = unpack_sockaddr_in ($sa1); ($p2,$a2) = unpack_sockaddr_in ($sa2); } elsif($this->{'sockfamily'} == AF_INET6()) { # IPv6 addresses ($p1,$a1) = unpack_sockaddr_in6 ($sa1); ($p2,$a2) = unpack_sockaddr_in6 ($sa2); } else { return 0; } use strict "subs"; if (! $this->{'lenient_source_address_matching'}) { return 0 if $a1 ne $a2; } if (! $this->{'lenient_source_port_matching'}) { return 0 if $p1 != $p2; } return 1; } sub receive_response_3 { my ($this, $response_tag, $oids, $errorp, $dont_block_p) = @_; my ($remote_addr); my $flags = 0; $flags = $dont_wait_flags if defined $dont_block_p and $dont_block_p; $remote_addr = recv ($this->sock,$this->{'pdu_buffer'},$this->max_pdu_len,$flags); return $this->error ("receiving response PDU: $!") unless defined $remote_addr; return $this->error ("short (".length $this->{'pdu_buffer'} ." bytes) response PDU") unless length $this->{'pdu_buffer'} > 2; my $response = $this->{'pdu_buffer'}; ## ## Check whether the response came from the address we've sent the ## request to. If this is not the case, we should probably ignore ## it, as it may relate to another request. ## if (defined $this->{'remote_addr'}) { if (! $this->sa_equal_p ($remote_addr, $this->{'remote_addr'})) { if ($this->{'debug'} && !$SNMP_Session::recycle_socket) { carp ("Response came from ".&SNMP_Session::pretty_address($remote_addr) .", not ".&SNMP_Session::pretty_address($this->{'remote_addr'})) unless $SNMP_Session::suppress_warnings; } return 0; } } $this->{'last_sender_addr'} = $remote_addr; my ($response_community, $response_id, @unwrapped) = $this->unwrap_response_5b ($response, $response_tag, $oids, $errorp); if ($response_community ne $this->{community} || $response_id ne $this->{request_id}) { if ($this->{'debug'}) { carp ("$response_community != $this->{community}") unless $SNMP_Session::suppress_warnings || $response_community eq $this->{community}; carp ("$response_id != $this->{request_id}") unless $SNMP_Session::suppress_warnings || $response_id == $this->{request_id}; } return 0; } if (!defined $unwrapped[0]) { $this->{'unwrapped'} = undef; return undef; } $this->{'unwrapped'} = \@unwrapped; return length $this->pdu_buffer; } sub receive_trap { my ($this) = @_; my ($remote_addr, $iaddr, $port, $trap); $remote_addr = recv ($this->sock,$this->{'pdu_buffer'},$this->max_pdu_len,0); return undef unless $remote_addr; if( (defined $ipv6_addr_len) && (length $remote_addr == $ipv6_addr_len)) { ($port,$iaddr) = unpack_sockaddr_in6($remote_addr); } else { ($port,$iaddr) = unpack_sockaddr_in($remote_addr); } $trap = $this->{'pdu_buffer'}; return ($trap, $iaddr, $port); } sub describe { my($this) = shift; print $this->to_string (),"\n"; } sub to_string { my($this) = shift; my ($class,$prefix); $class = ref($this); $prefix = ' ' x (length ($class) + 2); ($class .(defined $this->{remote_hostname} ? " (remote host: \"".$this->{remote_hostname}."\"" ." ".&SNMP_Session::pretty_address ($this->remote_addr).")" : " (no remote host specified)") ."\n" .$prefix." community: \"".$this->{'community'}."\"\n" .$prefix." request ID: ".$this->{'request_id'}."\n" .$prefix."PDU bufsize: ".$this->{'max_pdu_len'}." bytes\n" .$prefix." timeout: ".$this->{timeout}."s\n" .$prefix." retries: ".$this->{retries}."\n" .$prefix." backoff: ".$this->{backoff}.")"); ## sprintf ("SNMP_Session: %s (size %d timeout %g)", ## &SNMP_Session::pretty_address ($this->remote_addr),$this->max_pdu_len, ## $this->timeout); } ### SNMP Agent support ### contributed by Mike McCauley ### sub receive_request { my ($this) = @_; my ($remote_addr, $iaddr, $port, $request); $remote_addr = recv($this->sock, $this->{'pdu_buffer'}, $this->{'max_pdu_len'}, 0); return undef unless $remote_addr; if( (defined $ipv6_addr_len) && (length $remote_addr == $ipv6_addr_len)) { ($port,$iaddr) = unpack_sockaddr_in6($remote_addr); } else { ($port,$iaddr) = unpack_sockaddr_in($remote_addr); } $request = $this->{'pdu_buffer'}; return ($request, $iaddr, $port); } sub decode_request { my ($this, $request) = @_; my ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings); ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::get_request); if (defined $snmp_version) { # Its a valid get_request return(SNMP_Session::get_request, $requestid, $bindings, $community); } ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::getnext_request); if (defined $snmp_version) { # Its a valid getnext_request return(SNMP_Session::getnext_request, $requestid, $bindings, $community); } ($snmp_version, $community, $requestid, $errorstatus, $errorindex, $bindings) = decode_by_template ($request, "%{%i%s%*{%i%i%i%@", SNMP_Session::set_request); if (defined $snmp_version) { # Its a valid set_request return(SNMP_Session::set_request, $requestid, $bindings, $community); } # Something wrong with this packet # Decode failed return undef; } package SNMPv2c_Session; use strict qw(vars subs); # see above use vars qw(@ISA); use SNMP_Session; use BER; use Carp; @ISA = qw(SNMPv1_Session); sub snmp_version { 1 } sub open { my $session = SNMPv1_Session::open (@_); return undef unless defined $session; return bless $session; } ## map_table_start_end using get-bulk ## sub map_table_start_end ($$$$$$) { my ($session, $columns, $mapfn, $start, $end, $max_repetitions) = @_; my @encoded_oids; my $call_counter = 0; my $base_index = $start; my $ncols = @{$columns}; my @collected_values = (); if (! $session->{'use_getbulk'}) { return SNMP_Session::map_table_start_end ($session, $columns, $mapfn, $start, $end, $max_repetitions); } $max_repetitions = $session->default_max_repetitions unless defined $max_repetitions; for (;;) { foreach (@encoded_oids = @{$columns}) { $_=encode_oid (@{$_},split '\.',$base_index) || return $session->ber_error ("encoding OID $base_index"); } if ($session->getbulk_request_response (0, $max_repetitions, @encoded_oids)) { my $response = $session->pdu_buffer; my ($bindings) = $session->decode_get_response ($response); my @colstack = (); my $k = 0; my $j; my $min_index = undef; my @bases = @{$columns}; my $n_bindings = 0; my $binding; ## Copy all bindings into the colstack. ## The colstack is a vector of vectors. ## It contains one vector for each "repeater" variable. ## while ($bindings ne '') { ($binding, $bindings) = decode_sequence ($bindings); my ($oid, $value) = decode_by_template ($binding, "%O%@"); push @{$colstack[$k]}, [$oid, $value]; ++$k; $k = 0 if $k >= $ncols; } ## Now collect rows from the column stack: ## ## Iterate through the column stacks to find the smallest ## index, collecting the values for that index in ## @collected_values. ## ## As long as a row can be assembled, the map function is ## called on it and the iteration proceeds. ## $base_index = undef; walk_rows_from_pdu: for (;;) { my $min_index = undef; for ($k = 0; $k < $ncols; ++$k) { $collected_values[$k] = undef; my $pair = $colstack[$k]->[0]; unless (defined $pair) { $min_index = undef; last walk_rows_from_pdu; } my $this_index = SNMP_Session::oid_diff ($columns->[$k], $pair->[0]); if (defined $this_index) { my $cmp = !defined $min_index ? -1 : SNMP_Session::index_compare ($this_index, $min_index); if ($cmp == -1) { for ($j = 0; $j < $k; ++$j) { unshift (@{$colstack[$j]}, [$min_index, $collected_values[$j]]); $collected_values[$j] = undef; } $min_index = $this_index; } if ($cmp <= 0) { $collected_values[$k] = $pair->[1]; shift @{$colstack[$k]}; } } } ($base_index = undef), last if !defined $min_index; last if defined $end and SNMP_Session::index_compare ($min_index, $end) >= 0; &$mapfn ($min_index, @collected_values); ++$call_counter; $base_index = $min_index; } } else { return undef; } last if !defined $base_index; last if defined $end and SNMP_Session::index_compare ($base_index, $end) >= 0; } $call_counter; } 1; SNMP_Session-1.13/lib/SNMP_util.pm0000644000175000017500000012042111111365167016144 0ustar leinenleinen### - *- mode: Perl -*- ###################################################################### ### SNMP_util -- SNMP utilities using SNMP_Session.pm and BER.pm ###################################################################### ### Copyright (c) 1998-2008, Mike Mitchell. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### Created by: Mike Mitchell ### ### Contributions and fixes by: ### ### Tobias Oetiker : Basic layout ### Simon Leinen : SNMP_session.pm/BER.pm ### Jeff Allen : length() of undefined value ### Johannes Demel : MIB file parse problem ### Simon Leinen : more OIDs from Interface MIB ### Jacques Supcik : Specify local IP, port ### Tobias Oetiker : HASH as first OID to set SNMP options ### Simon Leinen : 'undefined port' bug ### Daniel McDonald : request for getbulk support ### Laurent Girod : code for snmpwalkhash ### Ian Duplisse : MIB parsing suggestions ### Jakob Ilves : return_array_refs for snmpwalk() ### Valerio Bontempi : IPv6 support ### Lorenzo Colitti : IPv6 support ### Joerg Kummer : TimeTicks support in snmpset() ### Christopher J. Tengi : Gauge32 support in snmpset() ### Nicolai Petri : hashref passing for snmpwalkhash() ###################################################################### package SNMP_util; require 5.004; use strict; use vars qw(@ISA @EXPORT $VERSION); use Exporter; use Carp; use BER "1.02"; use SNMP_Session "1.00"; use Socket; $VERSION = '1.13'; @ISA = qw(Exporter); @EXPORT = qw(snmpget snmpgetnext snmpwalk snmpset snmptrap snmpgetbulk snmpmaptable snmpmaptable4 snmpwalkhash snmpmapOID snmpMIB_to_OID snmpLoad_OID_Cache snmpQueue_MIB_File); # The OID numbers from RFC1213 (MIB-II) and RFC1315 (Frame Relay) # are pre-loaded below. %SNMP_util::OIDS = ( 'iso' => '1', 'org' => '1.3', 'dod' => '1.3.6', 'internet' => '1.3.6.1', 'directory' => '1.3.6.1.1', 'mgmt' => '1.3.6.1.2', 'mib-2' => '1.3.6.1.2.1', 'system' => '1.3.6.1.2.1.1', 'sysDescr' => '1.3.6.1.2.1.1.1.0', 'sysObjectID' => '1.3.6.1.2.1.1.2.0', 'sysUpTime' => '1.3.6.1.2.1.1.3.0', 'sysUptime' => '1.3.6.1.2.1.1.3.0', 'sysContact' => '1.3.6.1.2.1.1.4.0', 'sysName' => '1.3.6.1.2.1.1.5.0', 'sysLocation' => '1.3.6.1.2.1.1.6.0', 'sysServices' => '1.3.6.1.2.1.1.7.0', 'interfaces' => '1.3.6.1.2.1.2', 'ifNumber' => '1.3.6.1.2.1.2.1.0', 'ifTable' => '1.3.6.1.2.1.2.2', 'ifEntry' => '1.3.6.1.2.1.2.2.1', 'ifIndex' => '1.3.6.1.2.1.2.2.1.1', 'ifInOctets' => '1.3.6.1.2.1.2.2.1.10', 'ifInUcastPkts' => '1.3.6.1.2.1.2.2.1.11', 'ifInNUcastPkts' => '1.3.6.1.2.1.2.2.1.12', 'ifInDiscards' => '1.3.6.1.2.1.2.2.1.13', 'ifInErrors' => '1.3.6.1.2.1.2.2.1.14', 'ifInUnknownProtos' => '1.3.6.1.2.1.2.2.1.15', 'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16', 'ifOutUcastPkts' => '1.3.6.1.2.1.2.2.1.17', 'ifOutNUcastPkts' => '1.3.6.1.2.1.2.2.1.18', 'ifOutDiscards' => '1.3.6.1.2.1.2.2.1.19', 'ifDescr' => '1.3.6.1.2.1.2.2.1.2', 'ifOutErrors' => '1.3.6.1.2.1.2.2.1.20', 'ifOutQLen' => '1.3.6.1.2.1.2.2.1.21', 'ifSpecific' => '1.3.6.1.2.1.2.2.1.22', 'ifType' => '1.3.6.1.2.1.2.2.1.3', 'ifMtu' => '1.3.6.1.2.1.2.2.1.4', 'ifSpeed' => '1.3.6.1.2.1.2.2.1.5', 'ifPhysAddress' => '1.3.6.1.2.1.2.2.1.6', 'ifAdminHack' => '1.3.6.1.2.1.2.2.1.7', 'ifAdminStatus' => '1.3.6.1.2.1.2.2.1.7', 'ifOperHack' => '1.3.6.1.2.1.2.2.1.8', 'ifOperStatus' => '1.3.6.1.2.1.2.2.1.8', 'ifLastChange' => '1.3.6.1.2.1.2.2.1.9', 'at' => '1.3.6.1.2.1.3', 'atTable' => '1.3.6.1.2.1.3.1', 'atEntry' => '1.3.6.1.2.1.3.1.1', 'atIfIndex' => '1.3.6.1.2.1.3.1.1.1', 'atPhysAddress' => '1.3.6.1.2.1.3.1.1.2', 'atNetAddress' => '1.3.6.1.2.1.3.1.1.3', 'ip' => '1.3.6.1.2.1.4', 'ipForwarding' => '1.3.6.1.2.1.4.1', 'ipOutRequests' => '1.3.6.1.2.1.4.10', 'ipOutDiscards' => '1.3.6.1.2.1.4.11', 'ipOutNoRoutes' => '1.3.6.1.2.1.4.12', 'ipReasmTimeout' => '1.3.6.1.2.1.4.13', 'ipReasmReqds' => '1.3.6.1.2.1.4.14', 'ipReasmOKs' => '1.3.6.1.2.1.4.15', 'ipReasmFails' => '1.3.6.1.2.1.4.16', 'ipFragOKs' => '1.3.6.1.2.1.4.17', 'ipFragFails' => '1.3.6.1.2.1.4.18', 'ipFragCreates' => '1.3.6.1.2.1.4.19', 'ipDefaultTTL' => '1.3.6.1.2.1.4.2', 'ipAddrTable' => '1.3.6.1.2.1.4.20', 'ipAddrEntry' => '1.3.6.1.2.1.4.20.1', 'ipAdEntAddr' => '1.3.6.1.2.1.4.20.1.1', 'ipAdEntIfIndex' => '1.3.6.1.2.1.4.20.1.2', 'ipAdEntNetMask' => '1.3.6.1.2.1.4.20.1.3', 'ipAdEntBcastAddr' => '1.3.6.1.2.1.4.20.1.4', 'ipAdEntReasmMaxSize' => '1.3.6.1.2.1.4.20.1.5', 'ipRouteTable' => '1.3.6.1.2.1.4.21', 'ipRouteEntry' => '1.3.6.1.2.1.4.21.1', 'ipRouteDest' => '1.3.6.1.2.1.4.21.1.1', 'ipRouteAge' => '1.3.6.1.2.1.4.21.1.10', 'ipRouteMask' => '1.3.6.1.2.1.4.21.1.11', 'ipRouteMetric5' => '1.3.6.1.2.1.4.21.1.12', 'ipRouteInfo' => '1.3.6.1.2.1.4.21.1.13', 'ipRouteIfIndex' => '1.3.6.1.2.1.4.21.1.2', 'ipRouteMetric1' => '1.3.6.1.2.1.4.21.1.3', 'ipRouteMetric2' => '1.3.6.1.2.1.4.21.1.4', 'ipRouteMetric3' => '1.3.6.1.2.1.4.21.1.5', 'ipRouteMetric4' => '1.3.6.1.2.1.4.21.1.6', 'ipRouteNextHop' => '1.3.6.1.2.1.4.21.1.7', 'ipRouteType' => '1.3.6.1.2.1.4.21.1.8', 'ipRouteProto' => '1.3.6.1.2.1.4.21.1.9', 'ipNetToMediaTable' => '1.3.6.1.2.1.4.22', 'ipNetToMediaEntry' => '1.3.6.1.2.1.4.22.1', 'ipNetToMediaIfIndex' => '1.3.6.1.2.1.4.22.1.1', 'ipNetToMediaPhysAddress' => '1.3.6.1.2.1.4.22.1.2', 'ipNetToMediaNetAddress' => '1.3.6.1.2.1.4.22.1.3', 'ipNetToMediaType' => '1.3.6.1.2.1.4.22.1.4', 'ipRoutingDiscards' => '1.3.6.1.2.1.4.23', 'ipInReceives' => '1.3.6.1.2.1.4.3', 'ipInHdrErrors' => '1.3.6.1.2.1.4.4', 'ipInAddrErrors' => '1.3.6.1.2.1.4.5', 'ipForwDatagrams' => '1.3.6.1.2.1.4.6', 'ipInUnknownProtos' => '1.3.6.1.2.1.4.7', 'ipInDiscards' => '1.3.6.1.2.1.4.8', 'ipInDelivers' => '1.3.6.1.2.1.4.9', 'icmp' => '1.3.6.1.2.1.5', 'icmpInMsgs' => '1.3.6.1.2.1.5.1', 'icmpInTimestamps' => '1.3.6.1.2.1.5.10', 'icmpInTimestampReps' => '1.3.6.1.2.1.5.11', 'icmpInAddrMasks' => '1.3.6.1.2.1.5.12', 'icmpInAddrMaskReps' => '1.3.6.1.2.1.5.13', 'icmpOutMsgs' => '1.3.6.1.2.1.5.14', 'icmpOutErrors' => '1.3.6.1.2.1.5.15', 'icmpOutDestUnreachs' => '1.3.6.1.2.1.5.16', 'icmpOutTimeExcds' => '1.3.6.1.2.1.5.17', 'icmpOutParmProbs' => '1.3.6.1.2.1.5.18', 'icmpOutSrcQuenchs' => '1.3.6.1.2.1.5.19', 'icmpInErrors' => '1.3.6.1.2.1.5.2', 'icmpOutRedirects' => '1.3.6.1.2.1.5.20', 'icmpOutEchos' => '1.3.6.1.2.1.5.21', 'icmpOutEchoReps' => '1.3.6.1.2.1.5.22', 'icmpOutTimestamps' => '1.3.6.1.2.1.5.23', 'icmpOutTimestampReps' => '1.3.6.1.2.1.5.24', 'icmpOutAddrMasks' => '1.3.6.1.2.1.5.25', 'icmpOutAddrMaskReps' => '1.3.6.1.2.1.5.26', 'icmpInDestUnreachs' => '1.3.6.1.2.1.5.3', 'icmpInTimeExcds' => '1.3.6.1.2.1.5.4', 'icmpInParmProbs' => '1.3.6.1.2.1.5.5', 'icmpInSrcQuenchs' => '1.3.6.1.2.1.5.6', 'icmpInRedirects' => '1.3.6.1.2.1.5.7', 'icmpInEchos' => '1.3.6.1.2.1.5.8', 'icmpInEchoReps' => '1.3.6.1.2.1.5.9', 'tcp' => '1.3.6.1.2.1.6', 'tcpRtoAlgorithm' => '1.3.6.1.2.1.6.1', 'tcpInSegs' => '1.3.6.1.2.1.6.10', 'tcpOutSegs' => '1.3.6.1.2.1.6.11', 'tcpRetransSegs' => '1.3.6.1.2.1.6.12', 'tcpConnTable' => '1.3.6.1.2.1.6.13', 'tcpConnEntry' => '1.3.6.1.2.1.6.13.1', 'tcpConnState' => '1.3.6.1.2.1.6.13.1.1', 'tcpConnLocalAddress' => '1.3.6.1.2.1.6.13.1.2', 'tcpConnLocalPort' => '1.3.6.1.2.1.6.13.1.3', 'tcpConnRemAddress' => '1.3.6.1.2.1.6.13.1.4', 'tcpConnRemPort' => '1.3.6.1.2.1.6.13.1.5', 'tcpInErrs' => '1.3.6.1.2.1.6.14', 'tcpOutRsts' => '1.3.6.1.2.1.6.15', 'tcpRtoMin' => '1.3.6.1.2.1.6.2', 'tcpRtoMax' => '1.3.6.1.2.1.6.3', 'tcpMaxConn' => '1.3.6.1.2.1.6.4', 'tcpActiveOpens' => '1.3.6.1.2.1.6.5', 'tcpPassiveOpens' => '1.3.6.1.2.1.6.6', 'tcpAttemptFails' => '1.3.6.1.2.1.6.7', 'tcpEstabResets' => '1.3.6.1.2.1.6.8', 'tcpCurrEstab' => '1.3.6.1.2.1.6.9', 'udp' => '1.3.6.1.2.1.7', 'udpInDatagrams' => '1.3.6.1.2.1.7.1', 'udpNoPorts' => '1.3.6.1.2.1.7.2', 'udpInErrors' => '1.3.6.1.2.1.7.3', 'udpOutDatagrams' => '1.3.6.1.2.1.7.4', 'udpTable' => '1.3.6.1.2.1.7.5', 'udpEntry' => '1.3.6.1.2.1.7.5.1', 'udpLocalAddress' => '1.3.6.1.2.1.7.5.1.1', 'udpLocalPort' => '1.3.6.1.2.1.7.5.1.2', 'egp' => '1.3.6.1.2.1.8', 'egpInMsgs' => '1.3.6.1.2.1.8.1', 'egpInErrors' => '1.3.6.1.2.1.8.2', 'egpOutMsgs' => '1.3.6.1.2.1.8.3', 'egpOutErrors' => '1.3.6.1.2.1.8.4', 'egpNeighTable' => '1.3.6.1.2.1.8.5', 'egpNeighEntry' => '1.3.6.1.2.1.8.5.1', 'egpNeighState' => '1.3.6.1.2.1.8.5.1.1', 'egpNeighStateUps' => '1.3.6.1.2.1.8.5.1.10', 'egpNeighStateDowns' => '1.3.6.1.2.1.8.5.1.11', 'egpNeighIntervalHello' => '1.3.6.1.2.1.8.5.1.12', 'egpNeighIntervalPoll' => '1.3.6.1.2.1.8.5.1.13', 'egpNeighMode' => '1.3.6.1.2.1.8.5.1.14', 'egpNeighEventTrigger' => '1.3.6.1.2.1.8.5.1.15', 'egpNeighAddr' => '1.3.6.1.2.1.8.5.1.2', 'egpNeighAs' => '1.3.6.1.2.1.8.5.1.3', 'egpNeighInMsgs' => '1.3.6.1.2.1.8.5.1.4', 'egpNeighInErrs' => '1.3.6.1.2.1.8.5.1.5', 'egpNeighOutMsgs' => '1.3.6.1.2.1.8.5.1.6', 'egpNeighOutErrs' => '1.3.6.1.2.1.8.5.1.7', 'egpNeighInErrMsgs' => '1.3.6.1.2.1.8.5.1.8', 'egpNeighOutErrMsgs' => '1.3.6.1.2.1.8.5.1.9', 'egpAs' => '1.3.6.1.2.1.8.6', 'transmission' => '1.3.6.1.2.1.10', 'frame-relay' => '1.3.6.1.2.1.10.32', 'frDlcmiTable' => '1.3.6.1.2.1.10.32.1', 'frDlcmiEntry' => '1.3.6.1.2.1.10.32.1.1', 'frDlcmiIfIndex' => '1.3.6.1.2.1.10.32.1.1.1', 'frDlcmiState' => '1.3.6.1.2.1.10.32.1.1.2', 'frDlcmiAddress' => '1.3.6.1.2.1.10.32.1.1.3', 'frDlcmiAddressLen' => '1.3.6.1.2.1.10.32.1.1.4', 'frDlcmiPollingInterval' => '1.3.6.1.2.1.10.32.1.1.5', 'frDlcmiFullEnquiryInterval' => '1.3.6.1.2.1.10.32.1.1.6', 'frDlcmiErrorThreshold' => '1.3.6.1.2.1.10.32.1.1.7', 'frDlcmiMonitoredEvents' => '1.3.6.1.2.1.10.32.1.1.8', 'frDlcmiMaxSupportedVCs' => '1.3.6.1.2.1.10.32.1.1.9', 'frDlcmiMulticast' => '1.3.6.1.2.1.10.32.1.1.10', 'frCircuitTable' => '1.3.6.1.2.1.10.32.2', 'frCircuitEntry' => '1.3.6.1.2.1.10.32.2.1', 'frCircuitIfIndex' => '1.3.6.1.2.1.10.32.2.1.1', 'frCircuitDlci' => '1.3.6.1.2.1.10.32.2.1.2', 'frCircuitState' => '1.3.6.1.2.1.10.32.2.1.3', 'frCircuitReceivedFECNs' => '1.3.6.1.2.1.10.32.2.1.4', 'frCircuitReceivedBECNs' => '1.3.6.1.2.1.10.32.2.1.5', 'frCircuitSentFrames' => '1.3.6.1.2.1.10.32.2.1.6', 'frCircuitSentOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frOutOctets' => '1.3.6.1.2.1.10.32.2.1.7', 'frCircuitReceivedFrames' => '1.3.6.1.2.1.10.32.2.1.8', 'frCircuitReceivedOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frInOctets' => '1.3.6.1.2.1.10.32.2.1.9', 'frCircuitCreationTime' => '1.3.6.1.2.1.10.32.2.1.10', 'frCircuitLastTimeChange' => '1.3.6.1.2.1.10.32.2.1.11', 'frCircuitCommittedBurst' => '1.3.6.1.2.1.10.32.2.1.12', 'frCircuitExcessBurst' => '1.3.6.1.2.1.10.32.2.1.13', 'frCircuitThroughput' => '1.3.6.1.2.1.10.32.2.1.14', 'frErrTable' => '1.3.6.1.2.1.10.32.3', 'frErrEntry' => '1.3.6.1.2.1.10.32.3.1', 'frErrIfIndex' => '1.3.6.1.2.1.10.32.3.1.1', 'frErrType' => '1.3.6.1.2.1.10.32.3.1.2', 'frErrData' => '1.3.6.1.2.1.10.32.3.1.3', 'frErrTime' => '1.3.6.1.2.1.10.32.3.1.4', 'frame-relay-globals' => '1.3.6.1.2.1.10.32.4', 'frTrapState' => '1.3.6.1.2.1.10.32.4.1', 'snmp' => '1.3.6.1.2.1.11', 'snmpInPkts' => '1.3.6.1.2.1.11.1', 'snmpInBadValues' => '1.3.6.1.2.1.11.10', 'snmpInReadOnlys' => '1.3.6.1.2.1.11.11', 'snmpInGenErrs' => '1.3.6.1.2.1.11.12', 'snmpInTotalReqVars' => '1.3.6.1.2.1.11.13', 'snmpInTotalSetVars' => '1.3.6.1.2.1.11.14', 'snmpInGetRequests' => '1.3.6.1.2.1.11.15', 'snmpInGetNexts' => '1.3.6.1.2.1.11.16', 'snmpInSetRequests' => '1.3.6.1.2.1.11.17', 'snmpInGetResponses' => '1.3.6.1.2.1.11.18', 'snmpInTraps' => '1.3.6.1.2.1.11.19', 'snmpOutPkts' => '1.3.6.1.2.1.11.2', 'snmpOutTooBigs' => '1.3.6.1.2.1.11.20', 'snmpOutNoSuchNames' => '1.3.6.1.2.1.11.21', 'snmpOutBadValues' => '1.3.6.1.2.1.11.22', 'snmpOutGenErrs' => '1.3.6.1.2.1.11.24', 'snmpOutGetRequests' => '1.3.6.1.2.1.11.25', 'snmpOutGetNexts' => '1.3.6.1.2.1.11.26', 'snmpOutSetRequests' => '1.3.6.1.2.1.11.27', 'snmpOutGetResponses' => '1.3.6.1.2.1.11.28', 'snmpOutTraps' => '1.3.6.1.2.1.11.29', 'snmpInBadVersions' => '1.3.6.1.2.1.11.3', 'snmpEnableAuthenTraps' => '1.3.6.1.2.1.11.30', 'snmpInBadCommunityNames' => '1.3.6.1.2.1.11.4', 'snmpInBadCommunityUses' => '1.3.6.1.2.1.11.5', 'snmpInASNParseErrs' => '1.3.6.1.2.1.11.6', 'snmpInTooBigs' => '1.3.6.1.2.1.11.8', 'snmpInNoSuchNames' => '1.3.6.1.2.1.11.9', 'ifName' => '1.3.6.1.2.1.31.1.1.1.1', 'ifInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.2', 'ifInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.3', 'ifOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.4', 'ifOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.5', 'ifHCInOctets' => '1.3.6.1.2.1.31.1.1.1.6', 'ifHCInUcastPkts' => '1.3.6.1.2.1.31.1.1.1.7', 'ifHCInMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.8', 'ifHCInBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.9', 'ifHCOutOctets' => '1.3.6.1.2.1.31.1.1.1.10', 'ifHCOutUcastPkts' => '1.3.6.1.2.1.31.1.1.1.11', 'ifHCOutMulticastPkts' => '1.3.6.1.2.1.31.1.1.1.12', 'ifHCOutBroadcastPkts' => '1.3.6.1.2.1.31.1.1.1.13', 'ifLinkUpDownTrapEnable' => '1.3.6.1.2.1.31.1.1.1.14', 'ifHighSpeed' => '1.3.6.1.2.1.31.1.1.1.15', 'ifPromiscuousMode' => '1.3.6.1.2.1.31.1.1.1.16', 'ifConnectorPresent' => '1.3.6.1.2.1.31.1.1.1.17', 'ifAlias' => '1.3.6.1.2.1.31.1.1.1.18', 'ifCounterDiscontinuityTime' => '1.3.6.1.2.1.31.1.1.1.19', 'experimental' => '1.3.6.1.3', 'private' => '1.3.6.1.4', 'enterprises' => '1.3.6.1.4.1', ); # GIL my %revOIDS = (); # Reversed %SNMP_util::OIDS hash my $RevNeeded = 1; my $agent_start_time = time; undef $SNMP_util::Host; undef $SNMP_util::Session; undef $SNMP_util::Version; undef $SNMP_util::LHost; undef $SNMP_util::IPv4only; $SNMP_util::Debug = 0; $SNMP_util::CacheFile = "OID_cache.txt"; $SNMP_util::CacheLoaded = 0; $SNMP_util::Return_array_refs = 0; $SNMP_util::Return_hash_refs = 0; srand(time + $$); ### Prototypes sub snmpget ($@); sub snmpgetnext ($@); sub snmpopen ($$$); sub snmpwalk ($@); sub snmpwalk_flg ($$@); sub snmpset ($@); sub snmptrap ($$$$$@); sub snmpgetbulk ($$$@); sub snmpmaptable ($$@); sub snmpmaptable4 ($$$@); sub snmpwalkhash ($$@); sub toOID (@); sub snmpmapOID (@); sub snmpMIB_to_OID ($); sub encode_oid_with_errmsg ($); sub Check_OID ($); sub snmpLoad_OID_Cache ($); sub snmpQueue_MIB_File (@); sub MIB_fill_OID ($); sub version () { $VERSION; } # # Start an snmp session # sub snmpopen ($$$) { my($host, $type, $vars) = @_; my($nhost, $port, $community, $lhost, $lport, $nlhost); my($timeout, $retries, $backoff, $version); my $v4onlystr; $type = 0 if (!defined($type)); $community = "public"; $nlhost = ""; ($community, $host) = ($1, $2) if ($host =~ /^(.*)@([^@]+)$/); # We can't split on the : character because a numeric IPv6 # address contains a variable number of :'s my $opts; if( ($host =~ /^(\[.*\]):(.*)$/) or ($host =~ /^(\[.*\])$/) ) { # Numeric IPv6 address between [] ($host, $opts) = ($1, $2); } else { # Hostname or numeric IPv4 address ($host, $opts) = split(':', $host, 2); } ($port, $timeout, $retries, $backoff, $version, $v4onlystr) = split(':', $opts, 6) if(defined($opts) and (length $opts > 0) ); undef($version) if (defined($version) and length($version) <= 0); $v4onlystr = "" unless defined $v4onlystr; $version = '1' unless defined $version; if (defined($port) and ($port =~ /^([^!]*)!(.*)$/)) { ($port, $lhost) = ($1, $2); $nlhost = $lhost; ($lhost, $lport) = ($1, $2) if ($lhost =~ /^(.*)!(.*)$/); undef($lhost) if (defined($lhost) and (length($lhost) <= 0)); undef($lport) if (defined($lport) and (length($lport) <= 0)); } undef($port) if (defined($port) and length($port) <= 0); $port = 162 if ($type == 1 and !defined($port)); $nhost = "$community\@$host"; $nhost .= ":" . $port if (defined($port)); if ((!defined($SNMP_util::Session)) or ($SNMP_util::Host ne $nhost) or ($SNMP_util::Version ne $version) or ($SNMP_util::LHost ne $nlhost) or ($SNMP_util::IPv4only ne $v4onlystr)) { if (defined($SNMP_util::Session)) { $SNMP_util::Session->close(); undef $SNMP_util::Session; undef $SNMP_util::Host; undef $SNMP_util::Version; undef $SNMP_util::LHost; undef $SNMP_util::IPv4only; } $SNMP_util::Session = ($version =~ /^2c?$/i) ? SNMPv2c_Session->open($host, $community, $port, undef, $lport, undef, $lhost, ($v4onlystr eq 'v4only') ? 1:0 ) : SNMP_Session->open($host, $community, $port, undef, $lport, undef, $lhost, ($v4onlystr eq 'v4only') ? 1:0 ); ($SNMP_util::Host = $nhost, $SNMP_util::Version = $version, $SNMP_util::LHost = $nlhost, $SNMP_util::IPv4only = $v4onlystr) if defined($SNMP_util::Session); } if (defined($SNMP_util::Session)) { if (ref $vars->[0] eq 'HASH') { my $opts = shift @$vars; foreach $type (keys %$opts) { if ($type eq 'return_array_refs') { $SNMP_util::Return_array_refs = $opts->{$type}; } elsif ($type eq 'return_hash_refs') { $SNMP_util::Return_hash_refs = $opts->{$type}; } else { if (exists $SNMP_util::Session->{$type}) { if ($type eq 'timeout') { $SNMP_util::Session->set_timeout($opts->{$type}); } elsif ($type eq 'retries') { $SNMP_util::Session->set_retries($opts->{$type}); } elsif ($type eq 'backoff') { $SNMP_util::Session->set_backoff($opts->{$type}); } else { $SNMP_util::Session->{$type} = $opts->{$type}; } } else { carp "SNMPopen Unknown SNMP Option Key '$type'\n" unless ($SNMP_Session::suppress_warnings > 1); } } } } $SNMP_util::Session->set_timeout($timeout) if (defined($timeout) and (length($timeout) > 0)); $SNMP_util::Session->set_retries($retries) if (defined($retries) and (length($retries) > 0)); $SNMP_util::Session->set_backoff($backoff) if (defined($backoff) and (length($backoff) > 0)); } return $SNMP_util::Session; } # # A restricted snmpget. # sub snmpget ($@) { my($host, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding, $value, $oid, @retvals); my $session; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGET Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } @enoid = &toOID(@vars); return undef unless defined $enoid[0]; if ($session->get_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($value); push @retvals, $tempo; } return wantarray ? @retvals : $retvals[0]; } $var = join(' ', @vars); carp "SNMPGET Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } # # A restricted snmpgetnext. # sub snmpgetnext ($@) { my($host, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals); my($noid); my $session; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETNEXT Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } @enoid = &toOID(@vars); return undef unless defined $enoid[0]; undef @vars; undef @retvals; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } if ($session->getnext_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($oid); my $tempv = pretty_print($value); push @retvals, "$tempo:$tempv"; } return wantarray ? @retvals : $retvals[0]; } else { $var = join(' ', @vars); carp "SNMPGETNEXT Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } } # # A restricted snmpwalk. # sub snmpwalk ($@) { my($host, @vars) = @_; return(&snmpwalk_flg($host, undef, @vars)); } # # Walk the MIB, putting everything you find into hashes. # sub snmpwalkhash($$@) { # my($host, $hash_sub, @vars) = @_; return(&snmpwalk_flg( @_ )); } sub snmpwalk_flg ($$@) { my($host, $hash_sub, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals, @retvaltmprefs); my($got, @nnoid, $noid, $ok, $ix, @avars); my $session; my(%soid); my(%done, %rethash, $h_ref); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPWALK Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } $h_ref = (ref $vars[$#vars] eq "HASH") ? pop(@vars) : \%rethash; @enoid = toOID(@vars); return undef unless defined $enoid[0]; # GIL # # Create/Refresh a reversed hash with oid -> name # if (defined($hash_sub) and ($RevNeeded)) { %revOIDS = reverse %SNMP_util::OIDS; $RevNeeded = 0; } $got = 0; @nnoid = @enoid; undef @vars; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } # @vars is the original set of walked variables. # @avars is the current set of walked variables as the # walk goes on. # @vars stays static while @avars may shrink as we reach end # of walk for individual variables during PDU exchange. @avars = @vars; # IlvJa # # Create temporary array of refs to return vals. if ($SNMP_util::Return_array_refs) { for($ix = 0;$ix < scalar @vars; $ix++) { my $tmparray = []; $retvaltmprefs[$ix] = $tmparray; $retvals[$ix] = $tmparray; } } while(($SNMP_util::Version ne '1' and $session->{'use_getbulk'}) ? $session->getbulk_request_response(0, $session->default_max_repetitions(), @nnoid) : $session->getnext_request_response(@nnoid)) { $got = 1; $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); $ix = 0; while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); unless ($nnoid[$ix]) { # IlvJa $ix = ++$ix % (scalar @avars); next; } ($oid, $value) = decode_by_template($binding, "%O%@"); $ok = 0; my $tempo = pretty_print($oid); $noid = $avars[$ix]; # IlvJa if ($tempo =~ /^$noid\./ or $tempo eq $noid ) { $ok = 1; $upoid = $noid; } else { # IlvJa # # The walk for variable $vars[$ix] has been finished as # $nnoid[$ix] no longer is in the $avar[$ix] OID tree. # So we exclude this variable from further requests. $avars[$ix] = ""; $nnoid[$ix] = ""; $retvaltmprefs[$ix] = undef if $SNMP_util::Return_array_refs; } if ($ok) { my $tmp = encode_oid_with_errmsg ($tempo); return undef unless defined $tmp; if (exists($done{$tmp})) { # GIL, Ilvja # # We've detected a loop for $nnoid[$ix], so mark it as finished. # Exclude this variable from further requests. # $avars[$ix] = ""; $nnoid[$ix] = ""; $retvaltmprefs[$ix] = undef if $SNMP_util::Return_array_refs; next; } $nnoid[$ix] = $tmp; # Keep on walking. (IlvJa) my $tempv = pretty_print($value); if (defined($hash_sub)) { # # extract name of the oid, if possible, the rest becomes the instance # my $inst = ""; my $upo = $upoid; while (!exists($revOIDS{$upo}) and length($upo)) { $upo =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $upo = ""; last; } } if (length($upo) and exists($revOIDS{$upo})) { $upo = $revOIDS{$upo} . $inst; } else { $upo = $upoid; } $inst = ""; while (!exists($revOIDS{$tempo}) and length($tempo)) { $tempo =~ s/(\.\d+?)$//; if (defined($1) and length($1)) { $inst = $1 . $inst; } else { $tempo = ""; last; } } if (length($tempo) and exists($revOIDS{$tempo})) { $var = $revOIDS{$tempo}; } else { $var = pretty_print($oid); } # # call hash_sub # &$hash_sub($h_ref, $host, $var, $tempo, $inst, $tempv, $upo); } else { if ($SNMP_util::Return_array_refs) { $tempo=~s/^$upoid\.//; push @{$retvaltmprefs[$ix]}, "$tempo:$tempv"; } else { $tempo=~s/^$upoid\.// if ($#enoid <= 0); push @retvals, "$tempo:$tempv"; } } $done{$tmp} = 1; # GIL } $ix = ++$ix % (scalar @avars); } # Ok, @nnoid should contain the remaining variables for the # next request. Some or all entries in @nnoid might be the empty # string. If the nth element in @nnoid is "" that means that # the walk related to the nth variable in the last request has been # completed and we should not include that var in subsequent reqs. # Clean up both @nnoid and @avars so "" elements are removed. @nnoid = grep (($_), @nnoid); @avars = grep (($_), @avars); @retvaltmprefs = grep (($_), @retvaltmprefs); last if ($#nnoid < 0); # @nnoid empty means we are done walking. } if ($got) { if (defined($hash_sub)) { return ($h_ref) if ($SNMP_util::Return_hash_refs); return (%$h_ref); } else { return (@retvals); } } else { $var = join(' ', @vars); carp "SNMPWALK Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } } # # A restricted snmpset. # sub snmpset($@) { my($host, @vars) = @_; my(@enoid, $response, $bindings, $binding); my($oid, @retvals, $type, $value, $val); my $session; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPSET Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } while(@vars) { ($oid) = toOID((shift @vars)); $type = shift @vars; $value = shift @vars; $type =~ tr/A-Z/a-z/; if ($type eq "int") { $val = encode_int($value); } elsif ($type eq "integer") { $val = encode_int($value); } elsif ($type eq "string") { $val = encode_string($value); } elsif ($type eq "octetstring") { $val = encode_string($value); } elsif ($type eq "octet string") { $val = encode_string($value); } elsif ($type eq "oid") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "object id") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "object identifier") { $val = encode_oid_with_errmsg($value); } elsif ($type eq "ipaddr") { $val = encode_ip_address($value); } elsif ($type eq "ip address") { $val = encode_ip_address($value); } elsif ($type eq "timeticks") { $val = encode_timeticks($value); } elsif ($type eq "uint") { $val = encode_uinteger32($value); } elsif ($type eq "uinteger") { $val = encode_uinteger32($value); } elsif ($type eq "uinteger32") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned int") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned integer") { $val = encode_uinteger32($value); } elsif ($type eq "unsigned integer32") { $val = encode_uinteger32($value); } elsif ($type eq "counter") { $val = encode_counter32($value); } elsif ($type eq "counter32") { $val = encode_counter32($value); } elsif ($type eq "counter64") { $val = encode_counter64($value); } elsif ($type eq "gauge") { $val = encode_gauge32($value); } elsif ($type eq "gauge32") { $val = encode_gauge32($value); } else { carp "unknown SNMP type: $type\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } if (!defined($val)) { carp "SNMP type $type value $value didn't encode properly\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } push @enoid, [$oid,$val]; } return undef unless defined $enoid[0]; if ($session->set_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($value); push @retvals, $tempo; } return wantarray ? @retvals : $retvals[0]; } return undef; } # # Send an SNMP trap # sub snmptrap($$$$$@) { my($host, $ent, $agent, $gen, $spec, @vars) = @_; my($oid, @retvals, $type, $value); my(@enoid); my $session; $session = &snmpopen($host, 1, \@vars); if (!defined($session)) { carp "SNMPTRAP Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } if ($agent =~ /^\d+\.\d+\.\d+\.\d+(.*)/ ) { $agent = pack("C*", split /\./, $agent); } else { $agent = inet_aton($agent); } push @enoid, toOID(($ent)); push @enoid, encode_ip_address($agent); push @enoid, encode_int($gen); push @enoid, encode_int($spec); push @enoid, encode_timeticks((time-$agent_start_time) * 100); while(@vars) { ($oid) = toOID((shift @vars)); $type = shift @vars; $value = shift @vars; if ($type =~ /string/i) { $value = encode_string($value); push @enoid, [$oid,$value]; } elsif ($type =~ /ipaddr/i) { $value = encode_ip_address($value); push @enoid, [$oid,$value]; } elsif ($type =~ /int/i) { $value = encode_int($value); push @enoid, [$oid,$value]; } elsif ($type =~ /oid/i) { my $tmp = encode_oid_with_errmsg($value); return undef unless defined $tmp; push @enoid, [$oid,$tmp]; } else { carp "unknown SNMP type: $type\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } } return($session->trap_request_send(@enoid)); } # # A restricted snmpgetbulk. # sub snmpgetbulk ($$$@) { my($host, $nr, $mr, @vars) = @_; my(@enoid, $var, $response, $bindings, $binding); my($value, $upoid, $oid, @retvals); my($noid); my $session; $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPGETBULK Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } @enoid = &toOID(@vars); return undef unless defined $enoid[0]; undef @vars; undef @retvals; foreach $noid (@enoid) { $upoid = pretty_print($noid); push(@vars, $upoid); } if ($session->getbulk_request_response($nr, $mr, @enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response($response); while ($bindings) { ($binding, $bindings) = decode_sequence($bindings); ($oid, $value) = decode_by_template($binding, "%O%@"); my $tempo = pretty_print($oid); my $tempv = pretty_print($value); push @retvals, "$tempo:$tempv"; } return (@retvals); } else { $var = join(' ', @vars); carp "SNMPGETBULK Problem for $var on $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } } # # walk a table, calling a user-supplied function for each # column of a table. # sub snmpmaptable($$@) { my($host, $fun, @vars) = @_; return snmpmaptable4($host, $fun, 0, @vars); } sub snmpmaptable4($$$@) { my($host, $fun, $max_reps, @vars) = @_; my(@enoid, $var, $session); $session = &snmpopen($host, 0, \@vars); if (!defined($session)) { carp "SNMPMAPTABLE Problem for $host\n" unless ($SNMP_Session::suppress_warnings > 1); return undef; } foreach $var (toOID(@vars)) { push(@enoid, [split('\.', pretty_print($var))]); } $max_reps = $session->default_max_repetitions() if ($max_reps <= 0); return $session->map_table_start_end( [@enoid], sub() { my ($ind, @vals) = @_; my (@pvals, $val); foreach $val (@vals) { push(@pvals, pretty_print($val)); } &$fun($ind, @pvals); }, "", undef, $max_reps); } # # Given an OID in either ASN.1 or mixed text/ASN.1 notation, return an # encoded OID. # sub toOID(@) { my(@vars) = @_; my($oid, $var, $tmp, $tmpv, @retvar); undef @retvar; foreach $var (@vars) { ($oid, $tmp) = &Check_OID($var); if (!$oid and $SNMP_util::CacheLoaded == 0) { $tmp = $SNMP_Session::suppress_warnings; $SNMP_Session::suppress_warnings = 1000; &snmpLoad_OID_Cache($SNMP_util::CacheFile); $SNMP_util::CacheLoaded = 1; $SNMP_Session::suppress_warnings = $tmp; ($oid, $tmp) = &Check_OID($var); } while (!$oid and $#SNMP_util::MIB_Files >= 0) { $tmp = $SNMP_Session::suppress_warnings; $SNMP_Session::suppress_warnings = 1000; snmpMIB_to_OID(shift(@SNMP_util::MIB_Files)); $SNMP_Session::suppress_warnings = $tmp; ($oid, $tmp) = &Check_OID($var); if ($oid) { open(CACHE, ">>$SNMP_util::CacheFile"); print CACHE "$tmp\t$oid\n"; close(CACHE); } } if ($oid) { $var =~ s/^$tmp/$oid/; } else { carp "Unknown SNMP var $var\n" unless ($SNMP_Session::suppress_warnings > 1); next; } while ($var =~ /\"([^\"]*)\"/) { $tmp = sprintf("%d.%s", length($1), join(".", map(ord, split(//, $1)))); $var =~ s/\"$1\"/$tmp/; } print "toOID: $var\n" if $SNMP_util::Debug; $tmp = encode_oid_with_errmsg($var); return undef unless defined $tmp; push(@retvar, $tmp); } return @retvar; } # # Add passed-in text, OID pairs to the OID mapping table. # sub snmpmapOID(@) { my(@vars) = @_; my($oid, $txt); while($#vars >= 0) { $txt = shift @vars; $oid = shift @vars; next unless($txt =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-])*$/); next unless($oid =~ /^\d+(\.\d+)*$/); $SNMP_util::OIDS{$txt} = $oid; $RevNeeded = 1; print "snmpmapOID: $txt => $oid\n" if $SNMP_util::Debug; } return undef; } # # Open the passed-in file name and read it in to populate # the cache of text-to-OID map table. It expects lines # with two fields, the first the textual string like "ifInOctets", # and the second the OID value, like "1.3.6.1.2.1.2.2.1.10". # # blank lines and anything after a '#' or between '--' is ignored. # sub snmpLoad_OID_Cache ($) { my($arg) = @_; my($txt, $oid); if (!open(CACHE, $arg)) { carp "snmpLoad_OID_Cache: Can't open $arg: $!" unless ($SNMP_Session::suppress_warnings > 1); return -1; } while() { s/#.*//; # '#' starts a comment s/--.*--//g; # comment delimited by '--', like MIBs s/--.*//; # comment started by '--' next if (/^$/); next unless (/\s/); # must have whitespace as separator chomp; ($txt, $oid) = split(' ', $_, 2); $txt = $1 if ($txt =~ /^[\'\"](.*)[\'\"]/); $oid = $1 if ($oid =~ /^[\'\"](.*)[\'\"]/); if (($txt =~ /^\.?\d+(\.\d+)*\.?$/) and ($oid !~ /^\.?\d+(\.\d+)*\.?$/)) { my($a) = $oid; $oid = $txt; $txt = $a; } $oid =~ s/^\.//; $oid =~ s/\.$//; &snmpmapOID($txt, $oid); } close(CACHE); return 0; } # # Check to see if an OID is in the text-to-OID cache. # Returns the OID and the corresponding text as two separate # elements. # sub Check_OID ($) { my($var) = @_; my($tmp, $tmpv, $oid); if ($var =~ /^[a-zA-Z][\w\-]*(\.[a-zA-Z][\w\-]*)*/) { $tmp = $&; $tmpv = $tmp; for (;;) { last if exists($SNMP_util::OIDS{$tmpv}); last if !($tmpv =~ s/^[^\.]*\.//); } $oid = $SNMP_util::OIDS{$tmpv}; if ($oid) { return ($oid, $tmp); } else { return undef; } } return ($var, $var); } # # Save the passed-in list of MIB files until an OID can't be # found in the existing table. At that time the MIB file will # be loaded, and the lookup attempted again. # sub snmpQueue_MIB_File (@) { my(@files) = @_; my($file); foreach $file (@files) { push(@SNMP_util::MIB_Files, $file); } } # # Read in the passed MIB file, parsing it # for their text-to-OID mappings # sub snmpMIB_to_OID ($) { my($arg) = @_; my($cnt, $quote, $buf, %tOIDs, $tgot); my($var, @parts, $strt, $indx, $ind, $val); if (!open(MIB, $arg)) { carp "snmpMIB_to_OID: Can't open $arg: $!" unless ($SNMP_Session::suppress_warnings > 1); return -1; } print "snmpMIB_to_OID: loading $arg\n" if $SNMP_util::Debug; $cnt = 0; $quote = 0; $tgot = 0; $buf = ''; while() { if ($quote) { next unless /"/; $quote = 0; } else { s/--.*--//g; # throw away comments (-- anything --) s/^\s*--.*//; # throw away comments at start of line } chomp; $buf .= ' ' . $_; $buf =~ s/"[^"]*"//g; if ($buf =~ /"/) { $quote = 1; next; } $buf =~ s/--.*--//g; # throw away comments (-- anything --) $buf =~ s/--.*//; # throw away comments (-- anything EOL) $buf =~ s/\s+/ /g; if ($buf =~ /DEFINITIONS *::= *BEGIN/) { $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $buf = ''; %tOIDs = (); $tgot = 0; next; } $buf =~ s/OBJECT-TYPE/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/OBJECT-GROUP/OBJECT IDENTIFIER/; $buf =~ s/MODULE-IDENTITY/OBJECT IDENTIFIER/; $buf =~ s/NOTIFICATION-TYPE/OBJECT IDENTIFIER/; $buf =~ s/ IMPORTS .*\;//; $buf =~ s/ SEQUENCE *{.*}//; $buf =~ s/ SYNTAX .*//; $buf =~ s/ [\w\-]+ *::= *OBJECT IDENTIFIER//; $buf =~ s/ OBJECT IDENTIFIER.*::= *{/ OBJECT IDENTIFIER ::= {/; if ($buf =~ / ([\w\-]+) OBJECT IDENTIFIER *::= *{([^}]+)}/) { $var = $1; $buf = $2; $buf =~ s/ +$//; $buf =~ s/\s+\(/\(/g; # remove spacing around '(' $buf =~ s/\(\s+/\(/g; $buf =~ s/\s+\)/\)/g; # remove spacing before ')' @parts = split(' ', $buf); $strt = ''; foreach $indx (@parts) { if ($indx =~ /([\w\-]+)\((\d+)\)/) { $ind = $1; $val = $2; if (exists($tOIDs{$strt})) { $tOIDs{$ind} = $tOIDs{$strt} . '.' . $val; } elsif ($strt ne '') { $tOIDs{$ind} = "${strt}.${val}"; } else { $tOIDs{$ind} = $val; } $strt = $ind; $tgot = 1; } elsif ($indx =~ /^\d+$/) { if (exists($tOIDs{$strt})) { $tOIDs{$var} = $tOIDs{$strt} . '.' . $indx; } else { $tOIDs{$var} = "${strt}.${indx}"; } $tgot = 1; } else { $strt = $indx; } } $buf = ''; } } $cnt += MIB_fill_OID(\%tOIDs) if ($tgot); $RevNeeded = 1 if ($cnt > 0); return $cnt; } # # Fill the OIDS hash with results from the MIB parsing # sub MIB_fill_OID ($) { my($href) = @_; my($cnt, $changed, @del, $var, $val, @parts, $indx); my(%seen); $cnt = 0; do { $changed = 0; @del = (); foreach $var (keys %$href) { $val = $href->{$var}; @parts = split('\.', $val); $val = ''; foreach $indx (@parts) { if ($indx =~ /^\d+$/) { $val .= '.' . $indx; } else { if (exists($SNMP_util::OIDS{$indx})) { $val = $SNMP_util::OIDS{$indx}; } else { $val .= '.' . $indx; } } } if ($val =~ /^[\d\.]+$/) { $val =~ s/^\.+//; if (!exists($SNMP_util::OIDS{$var}) || (length($val) > length($SNMP_util::OIDS{$var}))) { $SNMP_util::OIDS{$var} = $val; print "'$var' => '$val'\n" if $SNMP_util::Debug; $changed = 1; $cnt++; } push @del, $var; } } foreach $var (@del) { delete $href->{$var}; } } while($changed); $Carp::CarpLevel++; foreach $var (sort keys %$href) { $val = $href->{$var}; $val =~ s/\..*//; next if (exists($seen{$val})); $seen{$val} = 1; $seen{$var} = 1; carp "snmpMIB_to_OID: prefix \"$val\" unknown, load the parent MIB first.\n" unless ($SNMP_Session::suppress_warnings > 1); } $Carp::CarpLevel--; return $cnt; } sub encode_oid_with_errmsg ($) { my ($oid) = @_; my $tmp = encode_oid(split(/\./, $oid)); if (! defined $tmp) { carp "cannot encode Object ID $oid: $BER::errmsg" unless ($SNMP_Session::suppress_warnings > 1); return undef; } return $tmp; } 1; SNMP_Session-1.13/lib/BER.pm0000644000175000017500000006621311106124643014746 0ustar leinenleinen### -*- mode: Perl -*- ###################################################################### ### BER (Basic Encoding Rules) encoding and decoding. ###################################################################### ### Copyright (c) 1995-2008, Simon Leinen. ### ### This program is free software; you can redistribute it under the ### "Artistic License 2.0" included in this distribution ### (file "Artistic"). ###################################################################### ### This module implements encoding and decoding of ASN.1-based data ### structures using the Basic Encoding Rules (BER). Only the subset ### necessary for SNMP is implemented. ###################################################################### ### Created by: Simon Leinen ### ### Contributions and fixes by: ### ### Andrzej Tobola : Added long String decode ### Tobias Oetiker : Added 5 Byte Integer decode ... ### Dave Rand : Added SysUpTime decode ### Philippe Simonet : Support larger subids ### Yufang HU : Support even larger subids ### Mike Mitchell : New generalized encode_int() ### Mike Diehn : encode_ip_address() ### Rik Hoorelbeke : encode_oid() fix ### Brett T Warden : pretty UInteger32 ### Bert Driehuis : Handle SNMPv2 exception codes ### Jakob Ilves (/IlvJa) : PDU decoding ### Jan Kasprzak : Fix for PDU syntax check ### Milen Pavlov : Recognize variant length for ints ###################################################################### package BER; require 5.002; use strict; use vars qw(@ISA @EXPORT $VERSION $pretty_print_timeticks %pretty_printer %default_printer $errmsg); use Exporter; $VERSION = '1.05'; @ISA = qw(Exporter); @EXPORT = qw(context_flag constructor_flag encode_int encode_int_0 encode_null encode_oid encode_sequence encode_tagged_sequence encode_string encode_ip_address encode_timeticks encode_uinteger32 encode_counter32 encode_counter64 encode_gauge32 decode_sequence decode_by_template pretty_print pretty_print_timeticks hex_string hex_string_of_type encoded_oid_prefix_p errmsg register_pretty_printer unregister_pretty_printer); ### Variables ## Bind this to zero if you want to avoid that TimeTicks are converted ## into "human readable" strings containing days, hours, minutes and ## seconds. ## ## If the variable is zero, pretty_print will simply return an ## unsigned integer representing hundredths of seconds. ## $pretty_print_timeticks = 1; ### Prototypes sub encode_header ($$); sub encode_int_0 (); sub encode_int ($); sub encode_oid (@); sub encode_null (); sub encode_sequence (@); sub encode_tagged_sequence ($@); sub encode_string ($); sub encode_ip_address ($); sub encode_timeticks ($); sub pretty_print ($); sub pretty_using_decoder ($$); sub pretty_string ($); sub pretty_intlike ($); sub pretty_unsignedlike ($); sub pretty_oid ($); sub pretty_uptime ($); sub pretty_uptime_value ($); sub pretty_ip_address ($); sub pretty_generic_sequence ($); sub register_pretty_printer ($); sub unregister_pretty_printer ($); sub hex_string ($); sub hex_string_of_type ($$); sub decode_oid ($); sub decode_by_template; sub decode_by_template_2; sub decode_sequence ($); sub decode_int ($); sub decode_intlike ($); sub decode_unsignedlike ($); sub decode_intlike_s ($$); sub decode_string ($); sub decode_length ($@); sub encoded_oid_prefix_p ($$); sub decode_subid ($$$); sub decode_generic_tlv ($); sub error (@); sub template_error ($$$); sub version () { $VERSION; } ### Flags for different types of tags sub universal_flag { 0x00 } sub application_flag { 0x40 } sub context_flag { 0x80 } sub private_flag { 0xc0 } sub primitive_flag { 0x00 } sub constructor_flag { 0x20 } ### Universal tags sub boolean_tag { 0x01 } sub int_tag { 0x02 } sub bit_string_tag { 0x03 } sub octet_string_tag { 0x04 } sub null_tag { 0x05 } sub object_id_tag { 0x06 } sub sequence_tag { 0x10 } sub set_tag { 0x11 } sub uptime_tag { 0x43 } ### Flag for length octet announcing multi-byte length field sub long_length { 0x80 } ### SNMP specific tags sub snmp_ip_address_tag { 0x00 | application_flag () } sub snmp_counter32_tag { 0x01 | application_flag () } sub snmp_gauge32_tag { 0x02 | application_flag () } sub snmp_timeticks_tag { 0x03 | application_flag () } sub snmp_opaque_tag { 0x04 | application_flag () } sub snmp_nsap_address_tag { 0x05 | application_flag () } sub snmp_counter64_tag { 0x06 | application_flag () } sub snmp_uinteger32_tag { 0x07 | application_flag () } ## Error codes (SNMPv2 and later) ## sub snmp_nosuchobject { context_flag () | 0x00 } sub snmp_nosuchinstance { context_flag () | 0x01 } sub snmp_endofmibview { context_flag () | 0x02 } ### pretty-printer initialization code. Create a hash with ### the most common types of pretty-printer routines. BEGIN { $default_printer{int_tag()} = \&pretty_intlike; $default_printer{snmp_counter32_tag()} = \&pretty_unsignedlike; $default_printer{snmp_gauge32_tag()} = \&pretty_unsignedlike; $default_printer{snmp_counter64_tag()} = \&pretty_unsignedlike; $default_printer{snmp_uinteger32_tag()} = \&pretty_unsignedlike; $default_printer{octet_string_tag()} = \&pretty_string; $default_printer{object_id_tag()} = \&pretty_oid; $default_printer{snmp_ip_address_tag()} = \&pretty_ip_address; %pretty_printer = %default_printer; } #### Encoding sub encode_header ($$) { my ($type,$length) = @_; return pack ("C C", $type, $length) if $length < 128; return pack ("C C C", $type, long_length | 1, $length) if $length < 256; return pack ("C C n", $type, long_length | 2, $length) if $length < 65536; return error ("Cannot encode length $length yet"); } sub encode_int_0 () { return pack ("C C C", 2, 1, 0); } sub encode_int ($) { return encode_intlike ($_[0], int_tag); } sub encode_uinteger32 ($) { return encode_intlike ($_[0], snmp_uinteger32_tag); } sub encode_counter32 ($) { return encode_intlike ($_[0], snmp_counter32_tag); } sub encode_counter64 ($) { return encode_intlike ($_[0], snmp_counter64_tag); } sub encode_gauge32 ($) { return encode_intlike ($_[0], snmp_gauge32_tag); } sub encode_intlike ($$) { my ($int, $tag)=@_; my ($sign, $val, @vals); $sign = ($int >= 0) ? 0 : 0xff; if (ref $int && $int->isa ("Math::BigInt")) { for(;;) { $val = $int->copy()->bmod (256); unshift(@vals, $val); return encode_header ($tag, $#vals + 1).pack ("C*", @vals) if ($int >= -128 && $int < 128); $int->bsub ($sign)->bdiv (256); } } else { for(;;) { $val = $int & 0xff; unshift(@vals, $val); return encode_header ($tag, $#vals + 1).pack ("C*", @vals) if ($int >= -128 && $int < 128); $int -= $sign, $int = int($int / 256); } } } sub encode_oid (@) { my @oid = @_; my ($result,$subid); $result = ''; ## Ignore leading empty sub-ID. The favourite reason for ## those to occur is that people cut&paste numeric OIDs from ## CMU/UCD SNMP including the leading dot. shift @oid if $oid[0] eq ''; return error ("Object ID too short: ", join('.',@oid)) if $#oid < 1; ## The first two subids in an Object ID are encoded as a single ## byte in BER, according to a funny convention. This poses ## restrictions on the ranges of those subids. In the past, I ## didn't check for those. But since so many people try to use ## OIDs in CMU/UCD SNMP's format and leave out the mib-2 or ## enterprises prefix, I introduced this check to catch those ## errors. ## return error ("first subid too big in Object ID ", join('.',@oid)) if $oid[0] > 2; $result = shift (@oid) * 40; $result += shift @oid; return error ("second subid too big in Object ID ", join('.',@oid)) if $result > 255; $result = pack ("C", $result); foreach $subid (@oid) { if ( ($subid>=0) && ($subid<128) ){ #7 bits long subid $result .= pack ("C", $subid); } elsif ( ($subid>=128) && ($subid<16384) ){ #14 bits long subid $result .= pack ("CC", 0x80 | $subid >> 7, $subid & 0x7f); } elsif ( ($subid>=16384) && ($subid<2097152) ) {#21 bits long subid $result .= pack ("CCC", 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } elsif ( ($subid>=2097152) && ($subid<268435456) ){ #28 bits long subid $result .= pack ("CCCC", 0x80 | (($subid>>21) & 0x7f), 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } elsif ( ($subid>=268435456) && ($subid<4294967296) ){ #32 bits long subid $result .= pack ("CCCCC", 0x80 | (($subid>>28) & 0x0f), #mask the bits beyond 32 0x80 | (($subid>>21) & 0x7f), 0x80 | (($subid>>14) & 0x7f), 0x80 | (($subid>>7) & 0x7f), $subid & 0x7f); } else { return error ("Cannot encode subid $subid"); } } encode_header (object_id_tag, length $result).$result; } sub encode_null () { encode_header (null_tag, 0); } sub encode_sequence (@) { encode_tagged_sequence (sequence_tag, @_); } sub encode_tagged_sequence ($@) { my ($tag,$result); $tag = shift @_; $result = join '',@_; return encode_header ($tag | constructor_flag, length $result).$result; } sub encode_string ($) { my ($string)=@_; return encode_header (octet_string_tag, length $string).$string; } sub encode_ip_address ($) { my ($addr)=@_; my @octets; if (length $addr == 4) { ## Four bytes... let's suppose that this is a binary IP address ## in network byte order. return encode_header (snmp_ip_address_tag, length $addr).$addr; } elsif (@octets = ($addr =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/)) { return encode_ip_address (pack ("CCCC", @octets)); } else { return error ("IP address must be four bytes long or a dotted-quad"); } } sub encode_timeticks ($) { my ($tt) = @_; return encode_intlike ($tt, snmp_timeticks_tag); } #### Decoding sub pretty_print ($) { my ($packet) = @_; return undef unless defined $packet; my $result = ord (substr ($packet, 0, 1)); if (exists ($pretty_printer{$result})) { my $c_ref = $pretty_printer{$result}; return &$c_ref ($packet); } return ($pretty_print_timeticks ? pretty_uptime ($packet) : pretty_unsignedlike ($packet)) if $result == uptime_tag; return "(null)" if $result == null_tag; return error ("Exception code: noSuchObject") if $result == snmp_nosuchobject; return error ("Exception code: noSuchInstance") if $result == snmp_nosuchinstance; return error ("Exception code: endOfMibView") if $result == snmp_endofmibview; # IlvJa # pretty print sequences and their contents. my $ctx_cons_flags = context_flag | constructor_flag; if($result == (&constructor_flag | &sequence_tag) # sequence || $result == (0 | $ctx_cons_flags) #get_request || $result == (1 | $ctx_cons_flags) #getnext_request || $result == (2 | $ctx_cons_flags) #response || $result == (3 | $ctx_cons_flags) #set_request || $result == (4 | $ctx_cons_flags) #trap_request || $result == (5 | $ctx_cons_flags) #getbulk_request || $result == (6 | $ctx_cons_flags) #inform_request || $result == (7 | $ctx_cons_flags) #trap2_request ) { my $pretty_result = pretty_generic_sequence($packet); $pretty_result =~ s/^/ /gm; #Indent. my $seq_type_desc = { (constructor_flag | sequence_tag) => "Sequence", (0 | $ctx_cons_flags) => "GetRequest", (1 | $ctx_cons_flags) => "GetNextRequest", (2 | $ctx_cons_flags) => "Response", (3 | $ctx_cons_flags) => "SetRequest", (4 | $ctx_cons_flags) => "Trap", (5 | $ctx_cons_flags) => "GetBulkRequest", (6 | $ctx_cons_flags) => "InformRequest", (7 | $ctx_cons_flags) => "SNMPv2-Trap", (8 | $ctx_cons_flags) => "Report", }->{($result)}; return $seq_type_desc . "{\n" . $pretty_result . "\n}"; } return sprintf ("#", $result); } sub pretty_using_decoder ($$) { my ($decoder, $packet) = @_; my ($decoded,$rest); ($decoded,$rest) = &$decoder ($packet); return error ("Junk after object") unless $rest eq ''; return $decoded; } sub pretty_string ($) { pretty_using_decoder (\&decode_string, $_[0]); } sub pretty_intlike ($) { my $decoded = pretty_using_decoder (\&decode_intlike, $_[0]); $decoded; } sub pretty_unsignedlike ($) { return pretty_using_decoder (\&decode_unsignedlike, $_[0]); } sub pretty_oid ($) { my ($oid) = shift; my ($result,$subid,$next); my (@oid); $result = ord (substr ($oid, 0, 1)); return error ("Object ID expected") unless $result == object_id_tag; ($result, $oid) = decode_length ($oid, 1); return error ("inconsistent length in OID") unless $result == length $oid; @oid = (); $subid = ord (substr ($oid, 0, 1)); push @oid, int ($subid / 40); push @oid, $subid % 40; $oid = substr ($oid, 1); while ($oid ne '') { $subid = ord (substr ($oid, 0, 1)); if ($subid < 128) { $oid = substr ($oid, 1); push @oid, $subid; } else { $next = $subid; $subid = 0; while ($next >= 128) { $subid = ($subid << 7) + ($next & 0x7f); $oid = substr ($oid, 1); $next = ord (substr ($oid, 0, 1)); } $subid = ($subid << 7) + $next; $oid = substr ($oid, 1); push @oid, $subid; } } join ('.', @oid); } sub pretty_uptime ($) { my ($packet,$uptime); ($uptime,$packet) = &decode_unsignedlike (@_); pretty_uptime_value ($uptime); } sub pretty_uptime_value ($) { my ($uptime) = @_; my ($seconds,$minutes,$hours,$days,$result); ## We divide the uptime by hundred since we're not interested in ## sub-second precision. $uptime = int ($uptime / 100); $days = int ($uptime / (60 * 60 * 24)); $uptime %= (60 * 60 * 24); $hours = int ($uptime / (60 * 60)); $uptime %= (60 * 60); $minutes = int ($uptime / 60); $seconds = $uptime % 60; if ($days == 0){ $result = sprintf ("%d:%02d:%02d", $hours, $minutes, $seconds); } elsif ($days == 1) { $result = sprintf ("%d day, %d:%02d:%02d", $days, $hours, $minutes, $seconds); } else { $result = sprintf ("%d days, %d:%02d:%02d", $days, $hours, $minutes, $seconds); } return $result; } sub pretty_ip_address ($) { my $pdu = shift; my ($length, $rest); return error ("IP Address tag (".snmp_ip_address_tag.") expected") unless ord (substr ($pdu, 0, 1)) == snmp_ip_address_tag; ($length,$pdu) = decode_length ($pdu, 1); return error ("Length of IP address should be four") unless $length == 4; sprintf "%d.%d.%d.%d", unpack ("CCCC", $pdu); } # IlvJa # Returns a string with the pretty prints of all # the elements in the sequence. sub pretty_generic_sequence ($) { my ($pdu) = shift; my $rest; my $type = ord substr ($pdu, 0 ,1); my $flags = context_flag | constructor_flag; return error (sprintf ("Tag 0x%x is not a valid sequence tag",$type)) unless ($type == (&constructor_flag | &sequence_tag) # sequence || $type == (0 | $flags) #get_request || $type == (1 | $flags) #getnext_request || $type == (2 | $flags) #response || $type == (3 | $flags) #set_request || $type == (4 | $flags) #trap_request || $type == (5 | $flags) #getbulk_request || $type == (6 | $flags) #inform_request || $type == (7 | $flags) #trap2_request ); my $curelem; my $pretty_result; # Holds the pretty printed sequence. my $pretty_elem; # Holds the pretty printed current elem. my $first_elem = 'true'; # Cut away the first Tag and Length from $packet and then # init $rest with that. (undef, $rest) = decode_length ($pdu, 1); while($rest) { ($curelem,$rest) = decode_generic_tlv($rest); $pretty_elem = pretty_print($curelem); $pretty_result .= "\n" if not $first_elem; $pretty_result .= $pretty_elem; # The rest of the iterations are not related to the # first element of the sequence so.. $first_elem = '' if $first_elem; } return $pretty_result; } sub hex_string ($) { &hex_string_of_type ($_[0], octet_string_tag); } sub hex_string_of_type ($$) { my ($pdu, $wanted_type) = @_; my ($length); return error ("BER tag ".$wanted_type." expected") unless ord (substr ($pdu, 0, 1)) == $wanted_type; ($length,$pdu) = decode_length ($pdu, 1); hex_string_aux ($pdu); } sub hex_string_aux ($) { my ($binary_string) = @_; my ($c, $result); $result = ''; for $c (unpack "C*", $binary_string) { $result .= sprintf "%02x", $c; } $result; } sub decode_oid ($) { my ($pdu) = @_; my ($result,$pdu_rest); my (@result); $result = ord (substr ($pdu, 0, 1)); return error ("Object ID expected") unless $result == object_id_tag; ($result, $pdu_rest) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu_rest; @result = (substr ($pdu, 0, $result + (length ($pdu) - length ($pdu_rest))), substr ($pdu_rest, $result)); @result; } # IlvJa # This takes a PDU and returns a two element list consisting of # the first element found in the PDU (whatever it is) and the # rest of the PDU sub decode_generic_tlv ($) { my ($pdu) = @_; my (@result); my ($elemlength,$pdu_rest) = decode_length ($pdu, 1); @result = (# Extract the first element. substr ($pdu, 0, $elemlength + (length ($pdu) - length ($pdu_rest) ) ), #Extract the rest of the PDU. substr ($pdu_rest, $elemlength) ); @result; } sub decode_by_template { my ($pdu) = shift; local ($_) = shift; return decode_by_template_2 ($pdu, $_, 0, 0, @_); } my $template_debug = 0; sub decode_by_template_2 { my ($pdu, $template, $pdu_index, $template_index); local ($_); $pdu = shift; $template = $_ = shift; $pdu_index = shift; $template_index = shift; my (@results); my ($length,$expected,$read,$rest); return undef unless defined $pdu; while (0 < length ($_)) { if (substr ($_, 0, 1) eq '%') { print STDERR "template $_ ", length $pdu," bytes remaining\n" if $template_debug; $_ = substr ($_,1); ++$template_index; if (($expected) = /^(\d*|\*)\{(.*)/) { ## %{ $template_index += length ($expected) + 1; print STDERR "%{\n" if $template_debug; $_ = $2; $expected = shift | constructor_flag if ($expected eq '*'); $expected = sequence_tag | constructor_flag if $expected eq ''; return template_error ("Unexpected end of PDU", $template, $template_index) if !defined $pdu or $pdu eq ''; return template_error ("Expected sequence tag $expected, got ". ord (substr ($pdu, 0, 1)), $template, $template_index) unless (ord (substr ($pdu, 0, 1)) == $expected); (($length,$pdu) = decode_length ($pdu, 1)) || return template_error ("cannot read length", $template, $template_index); return template_error ("Expected length $length, got ".length $pdu , $template, $template_index) unless length $pdu == $length; } elsif (($expected,$rest) = /^(\*|)s(.*)/) { ## %s $template_index += length ($expected) + 1; ($expected = shift) if $expected eq '*'; (($read,$pdu) = decode_string ($pdu)) || return template_error ("cannot read string", $template, $template_index); print STDERR "%s => $read\n" if $template_debug; if ($expected eq '') { push @results, $read; } else { return template_error ("Expected $expected, read $read", $template, $template_index) unless $expected eq $read; } $_ = $rest; } elsif (($rest) = /^A(.*)/) { ## %A $template_index += 1; { my ($tag, $length, $value); $tag = ord (substr ($pdu, 0, 1)); return error ("Expected IP address, got tag ".$tag) unless $tag == snmp_ip_address_tag; ($length, $pdu) = decode_length ($pdu, 1); return error ("Inconsistent length of InetAddress encoding") if $length > length $pdu; return template_error ("IP address must be four bytes long", $template, $template_index) unless $length == 4; $read = substr ($pdu, 0, $length); $pdu = substr ($pdu, $length); } print STDERR "%A => $read\n" if $template_debug; push @results, $read; $_ = $rest; } elsif (/^O(.*)/) { ## %O $template_index += 1; $_ = $1; (($read,$pdu) = decode_oid ($pdu)) || return template_error ("cannot read OID", $template, $template_index); print STDERR "%O => ".pretty_oid ($read)."\n" if $template_debug; push @results, $read; } elsif (($expected,$rest) = /^(\d*|\*|)i(.*)/) { ## %i $template_index += length ($expected) + 1; print STDERR "%i\n" if $template_debug; $_ = $rest; (($read,$pdu) = decode_int ($pdu)) || return template_error ("cannot read int", $template, $template_index); if ($expected eq '') { push @results, $read; } else { $expected = int (shift) if $expected eq '*'; return template_error (sprintf ("Expected %d (0x%x), got %d (0x%x)", $expected, $expected, $read, $read), $template, $template_index) unless ($expected == $read) } } elsif (($rest) = /^u(.*)/) { ## %u $template_index += 1; print STDERR "%u\n" if $template_debug; $_ = $rest; (($read,$pdu) = decode_unsignedlike ($pdu)) || return template_error ("cannot read uptime", $template, $template_index); push @results, $read; } elsif (/^\@(.*)/) { ## %@ $template_index += 1; print STDERR "%@\n" if $template_debug; $_ = $1; push @results, $pdu; $pdu = ''; } else { return template_error ("Unknown decoding directive in template: $_", $template, $template_index); } } else { if (substr ($_, 0, 1) ne substr ($pdu, 0, 1)) { return template_error ("Expected ".substr ($_, 0, 1).", got ".substr ($pdu, 0, 1), $template, $template_index); } $_ = substr ($_,1); $pdu = substr ($pdu,1); } } return template_error ("PDU too long", $template, $template_index) if length ($pdu) > 0; return template_error ("PDU too short", $template, $template_index) if length ($_) > 0; @results; } sub decode_sequence ($) { my ($pdu) = @_; my ($result); my (@result); $result = ord (substr ($pdu, 0, 1)); return error ("Sequence expected") unless $result == (sequence_tag | constructor_flag); ($result, $pdu) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu; @result = (substr ($pdu, 0, $result), substr ($pdu, $result)); @result; } sub decode_int ($) { my ($pdu) = @_; my $tag = ord (substr ($pdu, 0, 1)); return error ("Integer expected, found tag ".$tag) unless $tag == int_tag; decode_intlike ($pdu); } sub decode_intlike ($) { decode_intlike_s ($_[0], 1); } sub decode_unsignedlike ($) { decode_intlike_s ($_[0], 0); } my $have_math_bigint_p = 0; sub decode_intlike_s ($$) { my ($pdu, $signedp) = @_; my ($length,$result); ($length,$pdu) = decode_length ($pdu, 1); my $ptr = 0; $result = unpack ($signedp ? "c" : "C", substr ($pdu, $ptr++, 1)); if ($length > 5 || ($length == 5 && $result > 0)) { require 'Math/BigInt.pm' unless $have_math_bigint_p++; $result = new Math::BigInt ($result); } while (--$length > 0) { $result *= 256; $result += unpack ("C", substr ($pdu, $ptr++, 1)); } ($result, substr ($pdu, $ptr)); } sub decode_string ($) { my ($pdu) = shift; my ($result); $result = ord (substr ($pdu, 0, 1)); return error ("Expected octet string, got tag ".$result) unless $result == octet_string_tag; ($result, $pdu) = decode_length ($pdu, 1); return error ("Short PDU") if $result > length $pdu; return (substr ($pdu, 0, $result), substr ($pdu, $result)); } sub decode_length ($@) { my ($pdu) = shift; my $index = shift || 0; my ($result); my (@result); $result = ord (substr ($pdu, $index, 1)); if ($result & long_length) { if ($result == (long_length | 1)) { @result = (ord (substr ($pdu, $index+1, 1)), substr ($pdu, $index+2)); } elsif ($result == (long_length | 2)) { @result = ((ord (substr ($pdu, $index+1, 1)) << 8) + ord (substr ($pdu, $index+2, 1)), substr ($pdu, $index+3)); } else { return error ("Unsupported length"); } } else { @result = ($result, substr ($pdu, $index+1)); } @result; } # This takes a hashref that specifies functions to call when # the specified value type is being printed. It returns the # number of functions that were registered. sub register_pretty_printer($) { my ($h_ref) = shift; my ($type, $val, $cnt); $cnt = 0; while(($type, $val) = each %$h_ref) { if (ref $val eq "CODE") { $pretty_printer{$type} = $val; $cnt++; } } return($cnt); } # This takes a hashref that specifies functions to call when # the specified value type is being printed. It removes the # functions from the list for the types specified. # It returns the number of functions that were unregistered. sub unregister_pretty_printer($) { my ($h_ref) = shift; my ($type, $val, $cnt); $cnt = 0; while(($type, $val) = each %$h_ref) { if ((exists ($pretty_printer{$type})) && ($pretty_printer{$type} == $val)) { if (exists($default_printer{$type})) { $pretty_printer{$type} = $default_printer{$type}; } else { delete $pretty_printer{$type}; } $cnt++; } } return($cnt); } #### OID prefix check ### encoded_oid_prefix_p OID1 OID2 ### ### OID1 and OID2 should be BER-encoded OIDs. ### The function returns non-zero iff OID1 is a prefix of OID2. ### This can be used in the termination condition of a loop that walks ### a table using GetNext or GetBulk. ### sub encoded_oid_prefix_p ($$) { my ($oid1, $oid2) = @_; my ($i1, $i2); my ($l1, $l2); my ($subid1, $subid2); return error ("OID tag expected") unless ord (substr ($oid1, 0, 1)) == object_id_tag; return error ("OID tag expected") unless ord (substr ($oid2, 0, 1)) == object_id_tag; ($l1,$oid1) = decode_length ($oid1, 1); ($l2,$oid2) = decode_length ($oid2, 1); for ($i1 = 0, $i2 = 0; $i1 < $l1 && $i2 < $l2; ++$i1, ++$i2) { ($subid1,$i1) = &decode_subid ($oid1, $i1, $l1); ($subid2,$i2) = &decode_subid ($oid2, $i2, $l2); return 0 unless $subid1 == $subid2; } return $i2 if $i1 == $l1; return 0; } ### decode_subid OID INDEX ### ### Decodes a subid field from a BER-encoded object ID. ### Returns two values: the field, and the index of the last byte that ### was actually decoded. ### sub decode_subid ($$$) { my ($oid, $i, $l) = @_; my $subid = 0; my $next; while (($next = ord (substr ($oid, $i, 1))) >= 128) { $subid = ($subid << 7) + ($next & 0x7f); ++$i; return error ("decoding object ID: short field") unless $i < $l; } return (($subid << 7) + $next, $i); } sub error (@) { $errmsg = join ("",@_); return undef; } sub template_error ($$$) { my ($errmsg, $template, $index) = @_; return error ($errmsg."\n ".$template."\n ".(' ' x $index)."^"); } 1; SNMP_Session-1.13/test/0000755000175000017500000000000011111614635014202 5ustar leinenleinenSNMP_Session-1.13/test/SNMPAgent.pm0000644000175000017500000000665711106124642016310 0ustar leinenleinen# SNMPAgent.pm # # Object for handling SNMP requests as per draft-ietf-radius-servmib-04.txt # # Author: Mike McCauley (mikem@open.com.au) # Copyright (C) 1997 Open System Consultants # $Id: SNMPAgent.pm,v 1.2 1999-02-21 22:26:49 leinen Exp $ use SNMP_Session "0.68"; use SNMP_util; use Socket; $port = SNMP_Session::standard_udp_port; $session = SNMP_Session->open('0.0.0.0', '', $port, undef, $port); while (1) { &handle_socket_read(); } ##################################################################### # This function is called whenever there is a packet waiting to # be read from the SNMP port sub handle_socket_read { my ($fileno) = @_; my ($request, $iaddr, $port) = $session->receive_request(); if (defined $request) { my ($type, $requestid, $bindings, $community) = $session->decode_request($request); print "SNMPAgent: received request $type, $requestid, $community\n"; my ($error, $errorstatus, $errorindex); $errorstatus = $errorindex = 0; # Check the community if ($community ne 'public') { print "SNMPAgent: wrong community: $community. Ignored\n"; return; } my $index = 0; my @results; binding: while (!$errorstatus && $bindings ne '') { my $binding; ($binding, $bindings) = BER::decode_sequence($bindings); while (!$errorstatus && $binding ne '') { ($b, $binding) = BER::decode_sequence($binding); $index++; if ($type == SNMP_Session::get_request) { # SAMPLE code only: my ($oid) = BER::decode_oid($b); # Binary oid my $poid = BER::pretty_oid($oid); print "get request for $poid\n"; my $value = BER::encode_int(12345); push(@results, BER::encode_sequence($oid, $value)); } elsif ($type == SNMP_Session::getnext_request) { # SAMPLE code only: my ($oid) = BER::decode_oid($b); # Binary oid my $poid = BER::pretty_oid($oid); print "getnext request for $poid\n"; # fake up the next oid by just incrementing @fromoid = split(/\./, $poid); $fromoid[-1]++; print "changed to @fromoid\n"; $oid = BER::encode_oid(@fromoid); my $value = BER::encode_int(12345); push(@results, BER::encode_sequence($oid, $value)); } elsif ($type == SNMP_Session::set_request) { # SAMPLE code only: my ($oid, $value) = BER::decode_by_template($b, "%O%@"); my $poid = BER::pretty_oid($oid); ($value) = BER::decode_int($value); print "set request for $poid to $value\n"; $value = BER::encode_int($value); push(@results, BER::encode_sequence($oid, $value)); } else { warn "SNMPAgent: error decoding request: " . $BER::errmsg; return; } if ($errorstatus) { $errorindex = $index; last binding; } } } # OK we've got everything they asked for, so return it $request = BER::encode_tagged_sequence(SNMP_Session::get_response, BER::encode_int($requestid), BER::encode_int($errorstatus), BER::encode_int($errorindex), BER::encode_sequence(@results)) || warn "SNMPAgent: error encoding reply: " . $BER::errmsg; $session->{remote_addr} = Socket::pack_sockaddr_in($port, $iaddr); $session->{community} = $community; $request = $session->wrap_request($request); # tell the session where to send the reply to $session->send_query($request) || warn "SNMPAgent: error sending reply: $!"; } else { warn "SNMPAgent: receive_request failed: $!"; } } 1; SNMP_Session-1.13/test/if-to-routes.pl0000755000175000017500000000233011106124642017073 0ustar leinenleinen#!/usr/local/bin/perl -w ###################################################################### ### Name: if-to-routes.pl ### Date Created: Wed May 6 22:21:55 1998 ### Author: Simon Leinen ### RCS $Id: if-to-routes.pl,v 1.1 1998-05-06 20:31:01 simon Exp $ ###################################################################### ### Given an SNMP interface index, list the destination networks and ### netmasks for all routes which point to that interface. ###################################################################### use strict; use BER; use SNMP_Session "0.57"; sub usage(); my $if_index = shift @ARGV || usage (); my $target = shift @ARGV || usage (); my $community = shift @ARGV || 'public'; my $ipRouteIfIndex = [1,3,6,1,2,1,4,21,1,2]; my $ipRouteMask = [1,3,6,1,2,1,4,21,1,11]; my $session = SNMP_Session->open ($target, $community, 161) || die "Opening SNMP_Session"; $session->map_table ([$ipRouteIfIndex,$ipRouteMask], sub { my ($dest, $index, $mask) = @_; grep (defined $_ && ($_=pretty_print $_), ($index, $mask)); if ($index == $if_index) { print "$dest $mask\n"; } }); 1; sub usage () { die "usage: $0 if_index target [community]"; } SNMP_Session-1.13/test/discover0000755000175000017500000000365011106124642015750 0ustar leinenleinen#!/usr/local/bin/perl -w ### discover ### Author: Simon Leinen ### Date Created: 1998-Oct-16 ### ### discover ADDRESS [COMMUNITY] ### ### Send a specific SNMP request to a IP address and wait for replies. ### Can be used with a broadcast or multicast address to discover SNMP ### agents ("Command Responder Applications") responding to a given ### community. Warning: This code uses internal subroutines of the ### SNMP_Session.pm module which are subject to change :-( ### use strict; use vars qw($MULTILINE_MATCHING); require 5; use SNMP_Session "0.61"; use BER; use Socket; my $host = shift @ARGV || die; my $community = shift @ARGV || 'public'; my $sysDescr = encode_oid (1,3,6,1,2,1,1,1,0); my $session = SNMP_Session->open ($host, $community, 161) || die "Cannot open SNMP session"; my @oids = ($sysDescr); $session->send_query ($session->encode_get_request (@oids)); while ($session->wait_for_response ($session->timeout)) { my($response_length); $response_length = $session->receive_response_3 (SNMP_Session::get_response, \@oids, 0); if ($response_length) { my $response = $session->pdu_buffer; my ($binding, $bindings, $oid, $value); eval { ($bindings) = $session->decode_get_response ($response); }; while ($bindings ne '') { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); ##print $pretty_oids{$oid}," => ", { my $string = pretty_print ($value); my $sender = $session->{'last_sender_addr'}; local $MULTILINE_MATCHING = 1; $string =~ s/\n/\\n/g; $string =~ s/\r/\\r/g; print STDOUT pretty_address ($sender), "\n "; print STDOUT $string, "\n"; } } } } $session->close (); 1; sub pretty_address { my($addr) = shift; my($port,$ipaddr) = unpack_sockaddr_in($addr); my $hostname = gethostbyaddr ($ipaddr, AF_INET); return $hostname ? $hostname : ('['.inet_ntoa($ipaddr).']'); } SNMP_Session-1.13/test/set-test.pl0000755000175000017500000001241411106124642016312 0ustar leinenleinen#!/usr/local/bin/perl -w # # set-test: simple script to show usage of snmpget(), snmpset(), and # snmpgetnext() functions. # # # matter 9 July 1997 # a few changes by Simon Leinen , 16 August 1997 require 5.002; use strict; use SNMP_Session; use BER; # # OIDs we know by name. # my %OIDS = ( 'system' => '1.3.6.1.2.1.1', 'sysDescr' => '1.3.6.1.2.1.1.1', 'sysUptime' => '1.3.6.1.2.1.1.3', 'sysContact' => '1.3.6.1.2.1.1.4', 'sysLocation' => '1.3.6.1.2.1.1.6', ); my ($host, $oid, $community,$response); ($host = shift) or die "usage: $0 []"; $community = shift || 'public'; # # First a simple SNMP Get # $oid = "sysUptime.0"; print "Getting $oid from $host\n"; ($response) = &snmpget($host, $community, $oid); if ($response) { print "$oid : $response\n"; } else { print "$host did not respond to SNMP query\n"; exit; } # # Now a set # print "Before set:\n"; $oid = "sysContact.0"; ($response) = &snmpget($host, $community, $oid); if ($response) { print "$oid : $response\n"; } else { print "$host did not respond to SNMP query\n"; exit; } my $oldContact = $response; print "Setting contact to \"NecSys\"...\n"; ($response) = &snmpset($host, $community, $oid, 'string', 'NeCSys'); ($response) = &snmpget($host, $community, $oid); if ($response) { print "$oid : $response\n"; } else { print "$host did not respond to SNMP query\n"; exit; } print "Resetting contact to \"$oldContact\"...\n"; ($response) = &snmpset($host, $community, $oid, 'string', $oldContact); ($response) = &snmpget($host, $community, $oid); if ($response) { print "$oid : $response\n"; } else { print "$host did not respond to SNMP query\n"; exit; } # # This is a simple implementation of snmpwalk using snmpgetnext. # Note that snmpgetnext expects the OID to be encoded. # $oid = 'system'; $oid = toOID($oid); my $firstoid = $oid; my $prefixLength = length(BER::pretty_oid($oid))+1; my ($result,$value); print "Now we use SNMP GetNext to walk the system MIB\n"; while(1) { ($oid,$value) = &snmpgetnext($host, $community, $oid); last unless BER::encoded_oid_prefix_p($firstoid,$oid); next unless $value; $result = BER::pretty_oid($oid); # # This line truncates to OID to be relative to the starting OID # $result = substr($result,$prefixLength); print "system.$result: $value\n"; } sub snmpget { my($host,$community,@varList) = @_; my(@enoid, $var,$response, $bindings, $binding, $value, $inoid, $outoid, $upoid,$oid,@retvals); grep ($_=toOID($_), @varList); srand(); my $session = SNMP_Session->open ($host , $community, 161); if ($session->get_request_response(@varList)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response ($response); $session->close (); while ($bindings) { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); my $tempo = pretty_print($value); $tempo=~s/\t/ /g; $tempo=~s/\n/ /g; $tempo=~s/^\s+//; $tempo=~s/\s+$//; push @retvals, $tempo; } return (@retvals); } else { return (-1,-1); } } # # Unlike snmpget() and snmpset(), snmpgetnext() expects the OID to be # encoded. # sub snmpgetnext { my($host,$community,$var) = @_; my($response, $bindings, $binding, $value, $inoid, $outoid, $upoid,$oid,@retvals); srand(); my $session = SNMP_Session->open ($host , $community, 161); if ($session->getnext_request_response($var)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response ($response); $session->close (); while ($bindings) { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); my $tempo = pretty_print($value); $tempo=~s/\t/ /g; $tempo=~s/\n/ /g; $tempo=~s/^\s+//; $tempo=~s/\s+$//; push @retvals, $oid,$tempo; } return (@retvals); } else { return (-1,-1); } } sub snmpset { my($host,$community,@varList) = @_; my(@enoid, $response, $bindings, $binding, $inoid,$outoid, $upoid,$oid,@retvals); my ($type,$value); while (@varList) { $oid = toOID(shift @varList); $type = shift @varList; $value = shift @varList; ($type eq 'string') && do { $value = encode_string($value); push @enoid, [$oid,$value]; next; }; ($type eq 'int') && do { $value = encode_int($value); push @enoid, [$oid,$value]; next; }; die "Unknown SNMP type: $type"; } srand(); my $session = SNMP_Session->open ($host , $community, 161); if ($session->set_request_response(@enoid)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response ($response); $session->close (); while ($bindings) { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); my $tempo = pretty_print($value); $tempo=~s/\t/ /g; $tempo=~s/\n/ /g; $tempo=~s/^\s+//; $tempo=~s/\s+$//; push @retvals, $tempo; } return (@retvals); } else { return (-1,-1); } } # # Given an OID in either ASN.1 or mixed text/ASN.1 notation, return an # encoded OID. # sub toOID { my $var = shift; if ($var =~ /^([a-z]+[^\.]*)/i) { my $oid = $OIDS{$1}; if ($oid) { $var =~ s/$1/$oid/; } else { die "Unknown SNMP var $var\n" } } encode_oid((split /\./, $var)); } SNMP_Session-1.13/test/snmpwalkh.pl0000644000175000017500000000435711106124642016552 0ustar leinenleinen#!/usr/local/bin/perl # # File_________: snmpwalkh_test.pl # Date_________: 12.11.2001 # Author_______: Laurent Girod / Philip Morris Products S.A. / Neuchatel / Switzerland # Description__: Example of uses of the new snmpwalkhash function in SNMP_util # With snmpwalkhash, you can customize as you like your # results, in a hash of hashes, # by oid names, oid numbers, instances, like: # $hash{$host}{$name}{$inst} = $value; # $hash{$host}{$oid}{$inst} = $value; # $hash{$name}{$inst} = $value; # $hash{$oid}{$inst} = $value; # $hash{$oid.'.'.$inst} = $value; # $hash{$inst} = $value; # ... # Needed_______: ActiveState Perl 620 from www.perl.com # Modifications: # ######################################################################################################## use BER; use SNMP_util "0.90"; $BER::pretty_print_timeticks = 0; # Uptime in absolute value my $host = shift @ARGV || &usage; my $community = shift @ARGV || 'public'; &usage if $#ARGV >= 0; $host = "$community\@$host" if !($host =~ /\@/); # # Example 1: # my $oid_name = 'system'; print "\nCollecting [$oid_name]\n"; @ret = &snmpwalk($host, $oid_name); foreach $desc (@ret) { ($oid, $desc) = split(':', $desc, 2); print "$oid = $desc\n"; } # # Example 2: snmpwalk # my @oid_names = ('ifType', 'ifMtu', 'ifSpeed', 'ifPhysAddress',); print "\nCollecting "; map { print "[$_]\t" } @oid_names; print "\n"; @ret = &snmpwalk($host, @oid_names); foreach $desc (@ret) { ($oid, $desc) = split(':', $desc, 2); print "$oid = $desc\n"; } # # Example 3: snmpwalkhash # my %ret_hash = &snmpwalkhash($host, \&my_simple_hash, @oid_names); foreach $oid (keys %ret_hash) { foreach my $inst (sort { $a <=> $b } keys %{$ret_hash{$oid}}) { printf("%15s %3s = %s\n", $oid, $inst, $ret_hash{$oid}{$inst}); } } sub my_simple_hash { my ($h_ref, $host, $name, $oid, $inst, $value) = @_; $inst =~ s/^\.+//; if ($name =~/ifPhysAddress/) { my $mac = ''; map { $mac .= sprintf("%02X",$_) } unpack "CCCCCC", $value; $value = $mac; } $h_ref->{$name}->{$inst} = $value; } sub usage { die "usage: $0 hostname [community]"; } SNMP_Session-1.13/test/walk-intf.pl0000644000175000017500000000520011106124642016426 0ustar leinenleinen#!/usr/local/bin/perl -w ### ### Small test program that uses GetNext requests to walk the ### interfaces table. use strict; use BER; use SNMP_Session; ### Prototypes sub usage($ ); my $hostname = $ARGV[0] || usage (1); my $community = $ARGV[1] || usage (1); my $session; ## Set this if you want to see the OID for all printed values. my $print_oids_p = 0; die unless ($session = SNMP_Session->open ($hostname, $community, 161)); my @base_oids = ( encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.2')), # ifDescr encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.3')), # ifType encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.4')), # ifMtu encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.5')), # ifSpeed # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.6')), # ifPhysAddress encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.7')), # ifAdminStatus encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.8')), # ifOperStatus encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.9')), # ifLastChange encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.10')), # ifInOctets # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.11')), # ifInUcastPkts # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.12')), # ifInNUcastPkts # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.13')), # ifInDiscards # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.14')), # ifInErrors # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.15')), # ifInUnknownProtos encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.16')), # ifOutOctets # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.17')), # ifOutUcastPkts # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.18')), # ifOutNUcastPkts # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.19')), # ifOutDiscards # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.20')), # ifOutErrors # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.21')), # ifOutQLen # encode_oid (split ('\.', '1.3.6.1.2.1.2.2.1.22')), # ifSpecific ); my $oid; my $i; my @next_oids = @base_oids; ROW_LOOP: for (;;) { if ($session->getnext_request_response (@next_oids)) { my $response = $session->pdu_buffer; my ($bindings, $binding, $oid, $value); my ($base_oid); ($bindings) = $session->decode_get_response ($response); @next_oids = (); foreach $base_oid (@base_oids) { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); last ROW_LOOP unless BER::encoded_oid_prefix_p ($base_oid, $oid); push @next_oids, $oid; print pretty_print ($value); print ' [',pretty_print ($oid), "]" if $print_oids_p; print "\n"; } } else { die "No response received.\n"; } } $session->close (); 1; sub usage ($ ) { print STDERR "Usage: $0 hostname community\n"; exit (1) if $_[0]; } SNMP_Session-1.13/test/trap-send0000755000175000017500000000574111106124642016032 0ustar leinenleinen#!/usr/local/bin/perl -w ### ### trap-send HOST TRAP-COMMUNITY ### ### Author: Simon Leinen ### Date Created: 03-Jun-1998 ### ### Send linkDown trap to the designated management host/community ### ### This is intended to be a very simple example for sending SNMP(v1) ### traps. It doesn't do anything otherwise useful. ### use strict; use BER '0.58'; use SNMP_Session '0.58'; my $version = '1'; ### Forward declarations sub link_down_trap ($$); sub usage ($); while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { if ($ARGV[0] =~ /^-v/) { if ($ARGV[0] eq '-v') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] eq '1') { $version = '1'; } elsif ($ARGV[0] eq '2' || $ARGV[0] eq '2c') { $version = '2'; } else { usage (1); } } elsif ($ARGV[0] eq '-h') { usage (0); exit 0; } else { usage (1); } shift @ARGV; } my $trap_receiver = shift @ARGV || usage (1); my $trap_community = shift @ARGV || 'public'; my $trap_session = $version eq '1' ? SNMP_Session->open ($trap_receiver, $trap_community, 162) : SNMPv2c_Session->open ($trap_receiver, $trap_community, 162); my $start_time = time; link_down_trap (1,$version); 1; sub link_down_trap ($$) { my ($if_index, $version) = @_; my $genericTrap = 2; # linkDown my $specificTrap = 0; my @sysUptime_OID = ( 1,3,6,1,2,1,1,3 ); my @snmpTrapOID_OID = ( 1,3,6,1,6,3,1,1,4,1 ); my @ifIndex_OID = ( 1,3,6,1,2,1,2,2,1,1 ); my @ifDescr_OID = ( 1,3,6,1,2,1,2,2,1,2 ); my $upTime = int ((time - $start_time) * 100); my $myIpAddress = pack "CCCC", 130, 59, 4, 2; my @myOID = ( 1,3,6,1,4,1,2946,0,8,15 ); my @linkDown_OID = ( 1,3,6,1,6,3,1,1,5,3 ); warn "Sending trap failed" unless ($version eq '1') ? $trap_session->trap_request_send (encode_oid (@myOID), encode_ip_address ($myIpAddress), encode_int ($genericTrap), encode_int ($specificTrap), encode_timeticks ($upTime), [encode_oid (@ifIndex_OID,$if_index), encode_int ($if_index)], [encode_oid (@ifDescr_OID,$if_index), encode_string ("foo")]) : $trap_session->v2_trap_request_send (\@linkDown_OID, $upTime, [encode_oid (@ifIndex_OID,$if_index), encode_int ($if_index)], [encode_oid (@ifDescr_OID,$if_index), encode_string ("foo")]); } sub usage ($) { warn < ### Date Created: 2000/02/24 ### RCS $Id: cisco-cpus,v 1.1 2000-02-24 12:12:26 leinen Exp $ ### require 5.003; use strict; use BER; use SNMP_Session; my $host = shift @ARGV || die; my $community = shift @ARGV || die; ### From CISCO-PROCESS-MIB.my ### my $cpmCPUTotalPhysicalIndex = [1,3,6,1,4,1,9,9,109,1,1,1,1,2]; my $cpmCPUTotal5sec = [1,3,6,1,4,1,9,9,109,1,1,1,1,3]; my $cpmCPUTotal1min = [1,3,6,1,4,1,9,9,109,1,1,1,1,4]; my $cpmCPUTotal5min = [1,3,6,1,4,1,9,9,109,1,1,1,1,5]; sub out_cpu_totals { my ($index, $phys_index, $cpu_5sec, $cpu_1min, $cpu_5min) = @_; grep (defined $_ && ($_=pretty_print $_), ($phys_index, $cpu_5sec, $cpu_1min, $cpu_5min)); printf STDOUT ("%2d/%-3d %5.2f %5.2f %5.2f\n", $index, $phys_index, $cpu_5sec, $cpu_1min, $cpu_5min); } my $session = SNMP_Session->open ($host, $community, 161) || die "Opening SNMP_Session"; printf STDOUT ("Idx/Phy 5sec 1min 5min\n"); print STDOUT "-" x 24,"\n"; $session->map_table ([ $cpmCPUTotalPhysicalIndex, $cpmCPUTotal5sec, $cpmCPUTotal1min, $cpmCPUTotal5min], \&out_cpu_totals); $session->close (); 1; SNMP_Session-1.13/test/trap-listener0000755000175000017500000000743011106124642016723 0ustar leinenleinen#!/usr/local/bin/perl -w ### ### Listen for SNMP traps, decode and print them ### Simple example for a trap listener program. ### ### To make this useful, you should probably add some filtering ### capabilities and trap-specific pretty-printing. ### package main; use strict; use SNMP_Session; use SNMP_util; use BER; use Socket; ### Forward declarations sub print_trap ($$); sub usage ($ ); sub print_ip_addr ($ ); sub pretty_addr ($ ); sub hostname ($ ); sub fromOID ($ ); sub fromOID_aux ($$); sub really_pretty_oid ($); my $port = 162; my $print_community = 0; my $print_port = 0; my $print_hostname = 1; register_pretty_printer {BER::object_id_tag(), \&really_pretty_oid}; while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { if ($ARGV[0] eq '-p') { shift @ARGV; usage (1) unless defined $ARGV[0]; $port = $ARGV[0]; usage (1) unless $port > 0 && $port < 65536; } elsif ($ARGV[0] eq '-h') { usage (0); exit 0; } else { usage (1); } } snmpLoad_OID_Cache($SNMP_util::CacheFile); die unless SNMP_util::toOID("mib-2") eq SNMP_util::toOID ("1.3.6.1.2.1"); %SNMP_util::revOIDS = reverse %SNMP_util::OIDS unless %SNMP_util::revOIDS; my $session = SNMPv2c_Session->open_trap_session ($port) or die "couldn't open trap session"; $SNMP_Session::suppress_warnings = 1; # We print all error messages ourselves. my ($trap, $sender, $sender_port); while (($trap, $sender, $sender_port) = $session->receive_trap ()) { my $now_string = localtime time; print "$now_string "; print pretty_addr (inet_ntoa ($sender)); print ".$sender_port" if $print_port; print "\n"; print_trap ($session, $trap); } 1; sub print_trap ($$) { my ($this, $trap) = @_; my ($encoded_pair, $oid, $value); my ($community, $ent, $agent, $gen, $spec, $dt, $bindings) = $this->decode_trap_request ($trap); if (defined $community) { my ($binding, $prefix); if (defined $community) { print " community: ".$community."\n" if $print_community; if (defined $ent) { ## SNMPv1 Trap print " enterprise: ".BER::pretty_oid ($ent)."\n"; print " agent addr: ".inet_ntoa ($agent)."\n"; print " generic ID: $gen\n"; print " specific ID: $spec\n"; print " uptime: ".BER::pretty_uptime_value ($dt)."\n"; } ## Otherwise we have an SNMPv1 Trap which basically just ## consists of bindings. ## $prefix = " bindings: "; while ($bindings) { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); $oid = fromOID (BER::pretty_oid ($oid)); print $prefix.$oid.": ".pretty_print ($value)."\n"; $prefix = " "; } } else { warn "decoding trap request failed:\n".$SNMP_Session::errmsg; } } else { warn "receiving trap request failed:\n".$SNMP_Session::errmsg; } } sub usage ($) { warn <open ($host, $community, 161) : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, 161) : die "Unknown SNMP version $version") || die "Opening SNMP_Session"; $session->map_table ([$ifDescr,$locIfInBitsSec,$locIfOutBitsSec,$locIfDescr], \&out_interface); 1; SNMP_Session-1.13/test/cisco-memory0000755000175000017500000000306411106124642016537 0ustar leinenleinen#!/usr/local/bin/perl -w require 5.003; use strict; use BER; use SNMP_Session; my $host = shift @ARGV || die; my $community = shift @ARGV || die; my $ciscoMemoryPoolName = [1,3,6,1,4,1,9,9,48,1,1,1,2]; my $ciscoMemoryPoolAlternate = [1,3,6,1,4,1,9,9,48,1,1,1,3]; my $ciscoMemoryPoolValid = [1,3,6,1,4,1,9,9,48,1,1,1,4]; my $ciscoMemoryPoolUsed = [1,3,6,1,4,1,9,9,48,1,1,1,5]; my $ciscoMemoryPoolFree = [1,3,6,1,4,1,9,9,48,1,1,1,6]; my $ciscoMemoryPoolLargestFree = [1,3,6,1,4,1,9,9,48,1,1,1,7]; my %CiscoMemoryPoolTypes = ( 1 => "processor memory", 2 => "i/o memory", 3 => "pci memory", 4 => "fast memory", 5 => "multibus memory"); sub out_memory_pool_entry { my ($index, $name, $alt, $valid, $used, $free, $largest) = @_; grep (defined $_ && ($_=pretty_print $_), ($name, $alt, $valid, $used, $free, $largest)); my $type = $CiscoMemoryPoolTypes{$index} || $index; printf STDOUT ("%-13s %6d %3s %10d %10d %10d %10d\n", $name, $alt, $valid ? 'yes' : 'no', $used+$free, $used, $free, $largest); } my $session = SNMP_Session->open ($host, $community, 161) || die "Opening SNMP_Session"; printf STDOUT ("%-13s %6s %3s %10s %10s %10s %10s\n", "Name", "Alt", "Vld", "Total", "Used", "Free", "Largest"); print STDOUT "-" x (13+7+4+11+11+11+11),"\n"; $session->map_table ([ $ciscoMemoryPoolName, $ciscoMemoryPoolAlternate, $ciscoMemoryPoolValid, $ciscoMemoryPoolUsed, $ciscoMemoryPoolFree, $ciscoMemoryPoolLargestFree], \&out_memory_pool_entry); $session->close (); 1; SNMP_Session-1.13/test/test.pl0000755000175000017500000000503411106124642015521 0ustar leinenleinen#!/usr/local/bin/perl -w # Minimal useful application of the SNMP package. # Author: Simon Leinen # RCS $Header: /home/leinen/CVS/SNMP_Session/test/test.pl,v 1.18 2003-05-29 16:45:27 leinen Exp $ ###################################################################### # This application sends a get request for three fixed MIB-2 variable # instances (sysDescr.0, sysContact.0 and ipForwarding.0) to a given # host. The hostname and community string can be given as # command-line arguments. ###################################################################### require 5; use SNMP_Session; use BER; use strict; ### Prototypes sub usage(); sub snmp_get($@); $SNMP_Session::suppress_warnings = 1; my $ipv4_only_p = 0; my $snmp_version = 1; while ($#ARGV >= 0 and $ARGV[0] =~ /^-/) { if ($ARGV[0] eq '-4') { $ipv4_only_p = 1; } elsif ($ARGV[0] eq '-v') { shift @ARGV; usage () if $#ARGV < 0; if ($ARGV[0] =~ /^2c?/) { $snmp_version = 2; } elsif ($ARGV[0] eq '1') { $snmp_version = 1; } else { usage (); } } shift @ARGV; } my $hostname = shift @ARGV || usage (); my $community = shift @ARGV || 'public'; usage () if $#ARGV >= 0; my %ugly_oids = qw(sysDescr.0 1.3.6.1.2.1.1.1.0 sysContact.0 1.3.6.1.2.1.1.4.0 sysUptime.0 1.3.6.1.2.1.1.3.0 ipForwarding.0 1.3.6.1.2.1.4.1.0 ); my %pretty_oids; foreach (keys %ugly_oids) { $ugly_oids{$_} = encode_oid (split (/\./, $ugly_oids{$_})); $pretty_oids{$ugly_oids{$_}} = $_; } srand(); my $session = ($snmp_version == 1) ? SNMPv1_Session->open ($hostname, $community, 161, undef, undef, undef, undef, $ipv4_only_p) : SNMPv2c_Session->open ($hostname, $community, 161, undef, undef, undef, undef, $ipv4_only_p) or die "Couldn't open SNMP session to $hostname: $SNMP_Session::errmsg"; snmp_get ($session, qw(sysDescr.0 sysContact.0 sysUptime.0 ipForwarding.0)); $session->close (); 1; sub snmp_get ($@) { my($session, @oids) = @_; my($response, $bindings, $binding, $value, $oid); grep ($_ = $ugly_oids{$_}, @oids); if ($session->get_request_response (@oids)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response ($response); while ($bindings ne '') { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); print $pretty_oids{$oid}," => ", pretty_print ($value), "\n"; } } else { warn "SNMP problem: $SNMP_Session::errmsg\n"; } } sub usage () { die "usage: $0 [-4] [-v (1|2)] hostname [community]"; } SNMP_Session-1.13/test/README0000644000175000017500000000423411106124642015063 0ustar leinenleinenA collection of test scripts for the Perl SNMP code. arp Sample application that lists the ipNetToMediaTable of a host. Similar to the simple form of the Unix "arp" command. asn1-test.pl ber-test.pl A few regression tests for BER encoding. If you get errors running these, I'd be very interested to hear about it! cisco-cpus Use CISCO-PROCESS-MIB to get CPU utilization statistics from all processors in a Cisco router. This is most useful for routers with multiple CPUs, such as 7500 (RSP) routers with VIP2s, or Cisco 12000 (GSR) routers. cisco-memory Print global usage statistics (total/used/free bytes) for different types of memory on the main processor of a Cisco router. if-counters.pl (requires Curses.pm) Displays a router's byte and packet counter development in real-time. Demonstrates map_table_4 and a heuristic for maxRepetitions. iftop (requires Curses.pm) Display top interface counters in real time. Based on if-counters.pl. Contributed by Dave Plonka , see also http://net.doit.wisc.edu/~plonka/iftop/ set-test.pl Application that tries to change the sysContact.0 variable and then changes it back to the original value. Contributed by Matthew Trunnell SNMPAgent.pm Simple SNMP agent returning nonsense replies. Intended as an example of how to write agents. Contributed by Mike McCauley sun-find-process Use SEA's "sun" MIB to find process ID(s) of processes with a specific command name. sun-ps List the process table of a remote system using the "sun" MIB implemented in Sun's Solstice Enterprise Agents. test.pl Trivial application that reads some fixed variables from an agent. trap-send Send an SNMPv1 trap to a remote management station trap-listener Sit there and listen for SNMPv1 traps, which are decoded and written out in a readable form walk-intf.pl A variant of walk-test.pl that walks several columns of the RFC 1213 interfaces table. walk-test.pl Another trivial application that walks two columns in the interface table of RFC 1213. wwwtest Example for a CGI script that allows SNMP read access to a specific set of devices over the Web. SNMP_Session-1.13/test/test-table.pl0000755000175000017500000000112011106124642016576 0ustar leinenleinen#!/usr/local/bin/perl -w # # Regression tests for code used by table walking require 5.003; use strict; use BER; use SNMP_Session; &ic_test; 1; sub ic_test () { ic_test_1 ("1.2.3","1.2.4",-1); ic_test_1 ("1.2.3","1.2.3",0); ic_test_1 ("1.2.4","1.2.3",1); ic_test_1 ("1.2.29.1","1.2.3.2",1); ic_test_1 ("1.2.29.1","1.2.3",1); ic_test_1 ("1.2.29","1.2.3.32",1); } sub ic_test_1 ($$$) { my ($oid1, $oid2, $wanted) = @_; my $result; die "index_compare(\"$oid1\",\"$oid2\") == $result, should be $wanted" unless ($result = index_compare ($oid1,$oid2)) == $wanted; } SNMP_Session-1.13/test/walk-test.pl0000755000175000017500000001024011106124642016450 0ustar leinenleinen#!/usr/local/bin/perl -w ### ### Use map_table to list the ipAddrTable. use strict; use BER; use SNMP_Session; my $version = '1'; my $ifDescr = [1,3,6,1,2,1,2,2,1,2]; my $ipAdEntAddr = [1,3,6,1,2,1,4,20,1,1]; my $ipAdEntIfIndex = [1,3,6,1,2,1,4,20,1,2]; my $ipAdEntNetmask = [1,3,6,1,2,1,4,20,1,3]; my $ipAdEntBcastAddr = [1,3,6,1,2,1,4,20,1,4]; my $ipAdEntReasmMaxSize = [1,3,6,1,2,1,4,20,1,5]; ### If this is zero, the function pretty_net_and_mask will always ### print the prefix length in classless notation ### (e.g. 130.59.0.0/16), even if the prefix length is the classful ### default one for the address range in question. ### my $use_classful_defaults = 0; my $max_repetitions = 0; while (defined $ARGV[0] && $ARGV[0] =~ /^-/) { if ($ARGV[0] =~ /^-v/) { if ($ARGV[0] eq '-v') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] eq '1') { $version = '1'; } elsif ($ARGV[0] eq '2c') { $version = '2c'; } else { usage (1); } } elsif ($ARGV[0] =~ /^-m/) { if ($ARGV[0] eq '-m') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+$/) { $max_repetitions = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] eq '-h') { usage (0); exit 0; } else { usage (1); } shift @ARGV; } my $host = $ARGV[0] || die "usage: $0 target [community]"; my $community = $ARGV[1] || 'public'; my $session = ($version eq '1' ? SNMPv1_Session->open ($host, $community, 161) : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, 161) : die "Unknown SNMP version $version") || die "Opening SNMP_Session"; $max_repetitions = $session->default_max_repetitions unless $max_repetitions; $session->default_max_repetitions ($max_repetitions); my $if_descr = get_if_descrs ($session); printf "%-18s %s\n", "IP address", "if#"; $session->map_table ([$ipAdEntIfIndex, $ipAdEntNetmask, $ipAdEntBcastAddr, $ipAdEntReasmMaxSize], sub { my ($index, $if_index, $netmask, $bcast, $reasm) = @_; map { defined $_ && ($_=pretty_print $_) } ($if_index, $netmask, $bcast, $reasm); my $addr = $index; printf "%-18s %-20s ", pretty_net_and_mask ($addr, $netmask), $if_descr->{$if_index} || '?'; if (defined $bcast) { printf "%d", $bcast; } else { print "?"; } print " "; if (defined $reasm) { printf "%6d", $reasm; } else { print " ?"; } print "\n"; }); $session->close (); 1; sub netmask_to_prefix_length ($) { my ($mask) = @_; $mask = pack ("CCCC", split (/\./, $mask)); $mask = unpack ("N", $mask); my ($k); for ($k = 0; $k < 32; ++$k) { if ((($mask >> (31-$k)) & 1) == 0) { last; } } return $k; } sub pretty_net_and_mask ($$) { my ($net, $mask) = @_; my $prefix_length = netmask_to_prefix_length ($mask); my ($firstbyte) = split ('\.', $net); my $classful_prefix_length = $firstbyte < 128 ? 8 : $firstbyte < 192 ? 16 : $firstbyte < 224 ? 24 : -1; ($use_classful_defaults && $prefix_length == $classful_prefix_length) ? $net : $net.'/'.$prefix_length; } sub get_if_descrs ($) { my ($session) = @_; my %descrs = (); $session->map_table ([$ifDescr], sub { my ($index, $descr) = @_; $descrs{$index} = pretty_print ($descr); }); \%descrs; } sub usage ($) { warn < ### Date Created: 21-Feb-1999 ### ### Real-time full-screen display of the octet and (Cisco-specific) ### CRC error counters on interfaces of an SNMP-capable node ### ### Description: ### ### Call this script with "-h" to learn about command usage. ### ### The script will poll the RFC 1213 ifTable at specified intervals ### (default is every five seconds). ### ### For each interface except for those that are down, a line is ### written to the terminal which lists the interfaces name (ifDescr), ### well as the input and output transfer rates, as computed from the ### deltas of the respective octet counts since the last sample. ### ### "Alarms" ### ### When an interface is found to have had CRC errors in the last ### sampling interval, or only output, but no input traffic, it is ### shown in inverse video. In addition, when a link changes state ### (from normal to inverse or vice versa), a bell character is sent ### to the terminal. ### ### Miscellaneous ### ### Note that on the very first display, the actual SNMP counter ### values are displayed. THOSE ABSOLUTE COUNTER VALUES HAVE NO ### DEFINED SEMANTICS WHATSOEVER. However, in some versions of ### Cisco's software, the values seem to correspond to the total ### number of counted items since system boot (modulo 2^32). This can ### be useful for certain kinds of slowly advancing counters (such as ### CRC errors, hopefully). ### ### The topmost screen line shows the name of the managed node, as ### well as a few hard-to-explain items I found useful while debugging ### the script. ### ### Please send any patches and suggestions for improvement to the ### author (see e-mail address above). Hope you find this useful! ### ### Original Purpose: ### ### This script should serve as an example of how to "correctly" ### traverse the rows of a table. This functionality is implemented in ### the map_table() subroutine. The example script displays a few ### columns of the RFC 1213 interface table and Cisco's locIfTable. The ### tables share the same index, so they can be handled by a single ### invocation of map_table(). ### require 5.003; use strict; use BER; use SNMP_Session "0.67"; # requires map_table_4 use POSIX; # for exact time use Curses; use Math::BigInt; ### Forward declarations sub out_interface ($$$$$$@); sub pretty_bps ($$); sub usage ($ ); my $version = '1'; my $desired_interval = 10.0; my $all_p = 0; my $port = 161; my $max_repetitions = 0; my $suppress_output = 0; my $debug = 0; my $show_out_discards = 0; my $opt_P = 0; my $cisco_p = 0; my $counter64_p = 0; my $host; my $community; while (defined $ARGV[0]) { if ($ARGV[0] =~ /^-v/) { if ($ARGV[0] eq '-v') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] eq '1') { $version = '1'; } elsif ($ARGV[0] eq '2c') { $version = '2c'; } else { usage (1); } } elsif ($ARGV[0] =~ /^-m/) { if ($ARGV[0] eq '-m') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+$/) { $max_repetitions = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] =~ /^-p/) { if ($ARGV[0] eq '-p') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+$/) { $port = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] =~ /^-t/) { if ($ARGV[0] eq '-t') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+(\.[0-9]+)?$/) { $desired_interval = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] eq '-a') { $all_p = 1; } elsif ($ARGV[0] eq '-c') { $cisco_p = 1; } elsif ($ARGV[0] eq '-l') { $counter64_p = 1; } elsif ($ARGV[0] eq '-n') { $suppress_output = 1; } elsif ($ARGV[0] eq '-d') { $suppress_output = 1; $debug = 1; } elsif ($ARGV[0] eq '-D') { $show_out_discards = 1; } elsif ($ARGV[0] eq '-P') { $opt_P = 1; } elsif ($ARGV[0] eq '-h') { usage (0); exit 0; } elsif ($ARGV[0] =~ /^-/) { usage (1); } else { if (!defined $host) { $host = $ARGV[0]; } elsif (!defined $community) { $community = $ARGV[0]; } else { usage (1); } } shift @ARGV; } defined $host or usage (1); defined $community or $community = 'public'; usage (1) if $#ARGV >= $[; my $ifDescr = [1,3,6,1,2,1,2,2,1,2]; my $ifAdminStatus = [1,3,6,1,2,1,2,2,1,7]; my $ifOperStatus = [1,3,6,1,2,1,2,2,1,8]; my $ifInOctets = [1,3,6,1,2,1,2,2,1,10]; my $ifOutOctets = [1,3,6,1,2,1,2,2,1,16]; my $ifInUcastPkts = [1,3,6,1,2,1,2,2,1,11]; my $ifOutUcastPkts = [1,3,6,1,2,1,2,2,1,17]; my $ifOutDiscards = [1,3,6,1,2,1,2,2,1,19]; my $ifAlias = [1,3,6,1,2,1,31,1,1,1,18]; ## Counter64 variants my $ifHCInOctets = [1,3,6,1,2,1,31,1,1,1,6]; my $ifHCInUcastPkts = [1,3,6,1,2,1,31,1,1,1,7]; my $ifHCOutOctets = [1,3,6,1,2,1,31,1,1,1,10]; my $ifHCOutUcastPkts = [1,3,6,1,2,1,31,1,1,1,11]; ## Cisco-specific variables enabled by `-c' option my $locIfInCRC = [1,3,6,1,4,1,9,2,2,1,1,12]; my $locIfOutCRC = [1,3,6,1,4,1,9,2,2,1,1,12]; my $clock_ticks = POSIX::sysconf( &POSIX::_SC_CLK_TCK ); my $win = new Curses unless $suppress_output; my %old; my @ifactive; my $sleep_interval = $desired_interval + 0.0; my $interval; my $linecount; sub rate_32 ($$$@) { my ($old, $new, $interval, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; my $diff = $new-$old; if ($diff < 0) { $diff += (2**32); } return $diff / $interval * $multiplier; } sub rate_64 ($$$@) { my ($old, $new, $interval, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; return 0 if $old == $new; my $diff = Math::BigInt->new ($new-$old); if ($diff < 0) { $diff = $diff->add (2**64); } ## hrm. Why is this so complicated? ## I want a real programming language (such as Lisp). my $result = $diff->bnorm () / $interval * $multiplier; return $result; } sub rate ($$$$@) { my ($old, $new, $interval, $counter64_p, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; return $counter64_p ? rate_64 ($old, $new, $interval, $multiplier) : rate_32 ($old, $new, $interval, $multiplier); } sub rate_or_0 ($$$$$) { my ($old, $new, $interval, $counter64_p, $multiplier) = @_; return defined $new ? rate ($old, $new, $interval, $counter64_p, $multiplier) : 0; } sub handle_interface ($$$$$$@) { my ($index, $descr, $admin, $oper, $in, $out); my ($crc, $comment); my ($drops); my ($clock) = POSIX::times(); my $alarm = 0; ($index, $descr, $admin, $oper, $in, $out, $comment, @_) = @_; ($crc, @_) = @_ if $cisco_p; ($drops, @_) = @_ if $show_out_discards; grep (defined $_ && ($_=pretty_print $_), ($descr, $admin, $oper, $in, $out, $crc, $comment, $drops)); $win->clrtoeol () unless $suppress_output; return unless $all_p || defined $oper && $oper == 1; # up return unless defined $in && defined $out; ## Suppress interfaces called "unrouted VLAN..." return if $descr =~ /^unrouted VLAN/; if (!defined $old{$index}) { $win->addstr ($linecount, 0, sprintf ("%2d %-24s %10s %10s", $index, defined $descr ? $descr : '', defined $in ? $in : '-', defined $out ? $out : '-')) unless $suppress_output; if ($show_out_discards) { $win->addstr (sprintf (" %8s", defined $drops ? $drops : '-')) unless $suppress_output; } if ($cisco_p) { $win->addstr (sprintf (" %10s", defined $crc ? $crc : '-')) unless $suppress_output; } $win->addstr (sprintf (" %s", defined $comment ? $comment : '')) unless $suppress_output; ++$linecount; $win->refresh () unless $suppress_output; $old{$index} = {'in' => $in, 'out' => $out, 'crc' => $crc, 'drops' => $drops, 'clock' => $clock, 'alarm' => $alarm}; } else { my $old = $old{$index}; $interval = ($clock-$old->{'clock'}) * 1.0 / $clock_ticks; my $d_in = rate_or_0 ($old->{'in'}, $in, $interval, $counter64_p, $opt_P? 1 : 8); my $d_out = rate_or_0 ($old->{'out'}, $out, $interval, $counter64_p, $opt_P? 1 : 8); my $d_drops = rate_or_0 ($old->{'drops'}, $drops, $interval, 0, 1); my $d_crc = rate_or_0 ($old->{'crc'}, $crc, $interval, 0, 1); $alarm = ($d_crc != 0) || 0 && ($d_out > 0 && $d_in == 0); $old{$index} = {'in' => $in, 'out' => $out, 'crc' => $crc, 'drops' => $drops, 'clock' => $clock, 'alarm' => $alarm, 'descr' => $descr, # needed for display 'd_in' => $d_in, # needed for display 'd_out' => $d_out, # needed for display 'drops' => $d_drops, # needed for display 'crc' => $d_crc, # needed for display 'comment' => $comment, # needed for display }; push(@ifactive, $index); } } sub out_interface ($$$$$$@) { my ($index, $descr, $admin, $oper, $in, $out); my ($crc, $comment); my ($drops); my ($clock) = POSIX::times(); my $alarm = 0; ($index, $descr, $admin, $oper, $in, $out, $comment, @_) = @_; ($crc, @_) = @_ if $cisco_p; ($drops, @_) = @_ if $show_out_discards; grep (defined $_ && ($_=pretty_print $_), ($descr, $admin, $oper, $in, $out, $crc, $comment, $drops)); $win->clrtoeol () unless $suppress_output; return unless $all_p || defined $oper && $oper == 1; # up return unless defined $in && defined $out; ## Suppress interfaces called "unrouted VLAN..." return if $descr =~ /^unrouted VLAN/; if (!defined $old{$index}) { $win->addstr ($linecount, 0, sprintf ("%2d %-24s %10s %10s", $index, defined $descr ? $descr : '', defined $in ? $in : '-', defined $out ? $out : '-')) unless $suppress_output; if ($show_out_discards) { $win->addstr (sprintf (" %8s", defined $drops ? $drops : '-')) unless $suppress_output; } if ($cisco_p) { $win->addstr (sprintf (" %10s", defined $crc ? $crc : '-')) unless $suppress_output; } $win->addstr (sprintf (" %s", defined $comment ? $comment : '')) unless $suppress_output; } else { my $old = $old{$index}; $interval = ($clock-$old->{'clock'}) * 1.0 / $clock_ticks; my $d_in = rate_or_0 ($old->{'in'}, $in, $interval, $counter64_p, $opt_P? 1 : 8); my $d_out = rate_or_0 ($old->{'out'}, $out, $interval, $counter64_p, $opt_P? 1 : 8); my $d_drops = rate_or_0 ($old->{'drops'}, $drops, $interval, 0, 1); my $d_crc = rate_or_0 ($old->{'crc'}, $crc, $interval, 0, 1); $alarm = ($d_crc != 0) || 0 && ($d_out > 0 && $d_in == 0); print STDERR "\007" if $alarm && !$old->{'alarm'}; print STDERR "\007" if !$alarm && $old->{'alarm'}; $win->standout() if $alarm && !$suppress_output; $win->addstr ($linecount, 0, sprintf ("%2d %-24s %s %s", $index, defined $descr ? $descr : '', pretty_bps ($in, $d_in), pretty_bps ($out, $d_out))) unless $suppress_output; if ($show_out_discards) { $win->addstr (sprintf (" %8.1f %s", defined $drops ? $d_drops : 0)) unless $suppress_output; } if ($cisco_p) { $win->addstr (sprintf (" %10.1f", defined $crc ? $d_crc : 0)) unless $suppress_output; } $win->addstr (sprintf (" %s", defined $comment ? $comment : '')) unless $suppress_output; $win->standend() if $alarm && !$suppress_output; } $old{$index} = {'in' => $in, 'out' => $out, 'crc' => $crc, 'drops' => $drops, 'clock' => $clock, 'alarm' => $alarm}; ++$linecount; $win->refresh () unless $suppress_output; } sub update_interfaces () { foreach my $index (sort { $old{$b}->{d_in} <=> $old{$a}->{d_in} or $old{$b}->{d_out} <=> $old{$a}->{d_out} } @ifactive) { my $cur = $old{$index}; $win->addstr ($linecount, 0, sprintf ("%2d %-24s %s %s", $index, defined $cur->{descr} ? $cur->{descr} : '', pretty_bps ($cur->{in}, $cur->{d_in}), pretty_bps ($cur->{out}, $cur->{d_out}))) unless $suppress_output; if ($show_out_discards) { $win->addstr (sprintf (" %8.1f %s", defined $cur->{drops} ? $cur->{d_drops} : 0)) unless $suppress_output; } if ($cisco_p) { $win->addstr (sprintf (" %10.1f", defined $cur->{crc} ? $cur->{d_crc} : 0)) unless $suppress_output; } $win->addstr (sprintf (" %-80.80s", defined $cur->{comment} ? $cur->{comment} : '')) unless $suppress_output; ++$linecount; $win->refresh () unless $suppress_output; } } sub pretty_bps ($$) { my ($count, $bps) = @_; if (! defined $count) { return ' - '; } elsif ($bps > 1000000) { return sprintf ("%8.4f M", $bps/1000000); } elsif ($bps > 1000) { return sprintf ("%9.1fk", $bps/1000); } else { return sprintf ("%10.0f", $bps); } } $win->erase () unless $suppress_output; my $session = ($version eq '1' ? SNMPv1_Session->open ($host, $community, $port) : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, $port) : die "Unknown SNMP version $version") || die "Opening SNMP_Session"; $session->debug (1) if $debug; ### max_repetitions: ### ### We try to be smart about the value of $max_repetitions. Starting ### with the session default, we use the number of rows in the table ### (returned from map_table_4) to compute the next value. It should ### be one more than the number of rows in the table, because ### map_table needs an extra set of bindings to detect the end of the ### table. ### $max_repetitions = $session->default_max_repetitions unless $max_repetitions; while (1) { unless ($suppress_output) { $win->addstr (0, 0, sprintf ("%-20s interval %4.1fs %d reps", $host, $interval || $desired_interval, $max_repetitions)); $win->standout(); if ($opt_P) { $win->addstr (1, 0, sprintf (("%2s %-24s %10s %10s"), "ix", "name", "pkts/s", "pkts/s")); } else { $win->addstr (1, 0, sprintf (("%2s %-24s %10s %10s"), "ix", "name", "bits/s", "bits/s")); } if ($show_out_discards) { $win->addstr (sprintf ((" %8s"), "drops/s")); } if ($cisco_p) { $win->addstr (sprintf ((" %10s"), "pkts/s")); } $win->addstr (sprintf ((" %s"), "description")); $win->addstr (2, 0, sprintf (("%2s %-24s %10s %10s"), "", "", "in", "out")); if ($show_out_discards) { $win->addstr (sprintf ((" %8s"), "")); } if ($cisco_p) { $win->addstr (2, 0, sprintf ((" %10s %s"), "CRC", "")); } $win->clrtoeol (); $win->standend(); } $linecount = 3; my @oids = ($ifDescr,$ifAdminStatus,$ifOperStatus); if ($counter64_p) { if ($opt_P) { @oids = (@oids,$ifHCInUcastPkts,$ifHCOutUcastPkts); } else { @oids = (@oids,$ifHCInOctets,$ifHCOutOctets); } } else { if ($opt_P) { @oids = (@oids,$ifInUcastPkts,$ifOutUcastPkts); } else { @oids = (@oids,$ifInOctets,$ifOutOctets); } } @oids = (@oids,$ifAlias); if ($cisco_p) { push @oids, $locIfInCRC; } if ($show_out_discards) { push @oids, $ifOutDiscards; } @ifactive = (); my $calls = $session->map_table_4 (\@oids, \&handle_interface, $max_repetitions); update_interfaces() if @ifactive; $max_repetitions = $calls + 1 if $calls > 0; $sleep_interval -= ($interval - $desired_interval) if defined $interval; select (undef, undef, undef, $sleep_interval); } 1; sub usage ($) { warn < ### Date Created: 21-Feb-1999 ### ### Real-time full-screen display of the octet and (Cisco-specific) ### CRC error counters on interfaces of an SNMP-capable node ### ### Description: ### ### Call this script with "-h" to learn about command usage. ### ### The script will poll the RFC 1213 ifTable at specified intervals ### (default is every five seconds). ### ### For each interface except for those that are down, a line is ### written to the terminal which lists the interfaces name (ifDescr), ### well as the input and output transfer rates, as computed from the ### deltas of the respective octet counts since the last sample. ### ### "Alarms" ### ### When an interface is found to have had CRC errors in the last ### sampling interval, or only output, but no input traffic, it is ### shown in inverse video. In addition, when a link changes state ### (from normal to inverse or vice versa), a bell character is sent ### to the terminal. ### ### Miscellaneous ### ### Note that on the very first display, the actual SNMP counter ### values are displayed. THOSE ABSOLUTE COUNTER VALUES HAVE NO ### DEFINED SEMANTICS WHATSOEVER. However, in some versions of ### Cisco's software, the values seem to correspond to the total ### number of counted items since system boot (modulo 2^32). This can ### be useful for certain kinds of slowly advancing counters (such as ### CRC errors, hopefully). ### ### The topmost screen line shows the name of the managed node, as ### well as a few hard-to-explain items I found useful while debugging ### the script. ### ### Please send any patches and suggestions for improvement to the ### author (see e-mail address above). Hope you find this useful! ### ### Original Purpose: ### ### This script should serve as an example of how to "correctly" ### traverse the rows of a table. This functionality is implemented in ### the map_table() subroutine. The example script displays a few ### columns of the RFC 1213 interface table and Cisco's locIfTable. The ### tables share the same index, so they can be handled by a single ### invocation of map_table(). ### require 5.003; use strict; use BER; use SNMP_Session "0.96"; # requires map_table_4() and ipv4only use POSIX; # for exact time use Curses; use Math::BigInt; use Math::BigFloat; ### Forward declarations sub out_interface ($$$$$$@); sub pretty_ps ($$); sub usage ($ ); my $version = '1'; my $desired_interval = 5.0; my $switch_engine_p = 0; my $all_p = 0; my $port = 161; my $max_repetitions = 0; my $suppress_output = 0; my $suppress_curses = 0; my $debug = 0; my $show_out_discards = 0; my $cisco_p = 0; ## Whether to use 64-bit counters. Can be requested with `-l' option. my $counter64_p = 0; ## Whether to select IPv4-only in open(). Can be set using `-4' option. my $ipv4_only_p = 0; my $host; my $community; my $use_getbulk_p = 1; while (defined $ARGV[0]) { if ($ARGV[0] =~ /^-v/) { if ($ARGV[0] eq '-v') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] eq '1') { $version = '1'; } elsif ($ARGV[0] eq '2c' or $ARGV[0] eq '2') { $version = '2c'; } else { usage (1); } } elsif ($ARGV[0] =~ /^-m/) { if ($ARGV[0] eq '-m') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+$/) { $max_repetitions = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] =~ /^-p/) { if ($ARGV[0] eq '-p') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+$/) { $port = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] =~ /^-t/) { if ($ARGV[0] eq '-t') { shift @ARGV; usage (1) unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] =~ /^[0-9]+(\.[0-9]+)?$/) { $desired_interval = $ARGV[0]; } else { usage (1); } } elsif ($ARGV[0] eq '-B') { $use_getbulk_p = 0; } elsif ($ARGV[0] eq '-s') { $switch_engine_p = 1; } elsif ($ARGV[0] eq '-a') { $all_p = 1; } elsif ($ARGV[0] eq '-c') { $cisco_p = 1; } elsif ($ARGV[0] eq '-l') { $counter64_p = 1; } elsif ($ARGV[0] eq '-n') { $suppress_output = 1; $suppress_curses = 1; } elsif ($ARGV[0] eq '-C') { $suppress_output = 0; $suppress_curses = 1; } elsif ($ARGV[0] eq '-d') { $suppress_output = 0; $suppress_curses = 1; $debug = 1; } elsif ($ARGV[0] eq '-D') { $show_out_discards = 1; } elsif ($ARGV[0] eq '-4') { $ipv4_only_p = 1; } elsif ($ARGV[0] eq '-h') { usage (0); exit 0; } elsif ($ARGV[0] =~ /^-/) { usage (1); } else { if (!defined $host) { $host = $ARGV[0]; } elsif (!defined $community) { $community = $ARGV[0]; } else { usage (1); } } shift @ARGV; } defined $host or usage (1); defined $community or $community = 'public'; usage (1) if $#ARGV >= $[; my $ifDescr = [1,3,6,1,2,1,2,2,1,2]; my $ifAdminStatus = [1,3,6,1,2,1,2,2,1,7]; my $ifOperStatus = [1,3,6,1,2,1,2,2,1,8]; my $ifInOctets = [1,3,6,1,2,1,2,2,1,10]; my $ifOutOctets = [1,3,6,1,2,1,2,2,1,16]; my $ifInUcastPkts = [1,3,6,1,2,1,2,2,1,11]; my $ifOutUcastPkts = [1,3,6,1,2,1,2,2,1,17]; my $ifOutDiscards = [1,3,6,1,2,1,2,2,1,19]; my $ifAlias = [1,3,6,1,2,1,31,1,1,1,18]; ## Counter64 variants my $ifHCInOctets = [1,3,6,1,2,1,31,1,1,1,6]; my $ifHCOutOctets = [1,3,6,1,2,1,31,1,1,1,10]; ## Cisco-specific variables enabled by `-c' option my $locIfInCRC = [1,3,6,1,4,1,9,2,2,1,1,12]; my $locIfOutCRC = [1,3,6,1,4,1,9,2,2,1,1,12]; my $cseL3SwitchedTotalPkts = [1,3,6,1,4,1,9,9,97,1,4,1,1,1]; my $cseL3SwitchedTotalOctets = [1,3,6,1,4,1,9,9,97,1,4,1,1,2]; my $cseL3CandidateFlowHits = [1,3,6,1,4,1,9,9,97,1,4,1,1,3]; my $cseL3EstablishedFlowHits = [1,3,6,1,4,1,9,9,97,1,4,1,1,4]; my $cseL3ActiveFlows = [1,3,6,1,4,1,9,9,97,1,4,1,1,5]; my $cseL3FlowLearnFailures = [1,3,6,1,4,1,9,9,97,1,4,1,1,6]; my $cseL3IntFlowInvalids = [1,3,6,1,4,1,9,9,97,1,4,1,1,7]; my $cseL3ExtFlowInvalids = [1,3,6,1,4,1,9,9,97,1,4,1,1,8]; my $clock_ticks = POSIX::sysconf( &POSIX::_SC_CLK_TCK ); my $win = new Curses unless $suppress_curses; my %old; my $sleep_interval = $desired_interval + 0.0; my $interval; my $linecount; sub rate_32 ($$$@) { my ($old, $new, $interval, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; my $diff = $new-$old; if ($diff < 0) { $diff += (2**32); } return $diff / $interval * $multiplier; } sub rate_64 ($$$@) { my ($old, $new, $interval, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; return 0 if $old == $new; my $diff = Math::BigInt->new ($new-$old); if ($diff < 0) { $diff = $diff->add (2**64); } warn "rate_64 ($old, $new, $interval, $multiplier)\n" if $debug; warn " diff: $diff\n" if $debug; ## hrm. Why is this so complicated? ## I want a real programming language (such as Lisp). my $result = new Math::BigFloat ($diff->bnorm ()); warn " result: $result\n" if $debug; $result /= $interval; warn " result: $result\n" if $debug; $result *= $multiplier; warn " result: $result\n" if $debug; return $result; } sub rate ($$$$@) { my ($old, $new, $interval, $counter64_p, $multiplier) = @_; $multiplier = 1 unless defined $multiplier; return $counter64_p ? rate_64 ($old, $new, $interval, $multiplier) : rate_32 ($old, $new, $interval, $multiplier); } sub rate_or_0 ($$$@) { my ($old, $new, $interval, $counter64_p, $multiplier) = @_; $counter64_p = 0 unless defined $counter64_p; $multiplier = 1 unless defined $multiplier; return defined $new ? rate ($old, $new, $interval, $counter64_p, $multiplier) : 0; } sub out_interface ($$$$$$@) { my ($index, $descr, $admin, $oper, $in, $out); my ($crc, $comment); my ($drops); my ($clock) = POSIX::times(); my $alarm = 0; ($index, $descr, $admin, $oper, $in, $out, $comment, @_) = @_; ($crc, @_) = @_ if $cisco_p; ($drops, @_) = @_ if $show_out_discards; grep (defined $_ && ($_=pretty_print $_), ($descr, $admin, $oper, $in, $out, $crc, $comment, $drops)); $win->clrtoeol () unless $suppress_curses; return unless $all_p || defined $oper && $oper == 1; # up return unless defined $in && defined $out; ## Suppress interfaces called "unrouted VLAN..." return if $descr =~ /^unrouted VLAN/; if (!defined $old{$index}) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT ("%5d %-24s %10s %10s", $index, defined $descr ? $descr : '', defined $in ? $in : '-', defined $out ? $out : '-'); } else { $win->addstr ($linecount, 0, sprintf ("%5d %-24s %10s %10s", $index, defined $descr ? $descr : '', defined $in ? $in : '-', defined $out ? $out : '-')); } if ($show_out_discards) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %8s", defined $drops ? $drops : '-'); } else { $win->addstr (sprintf (" %8s", defined $drops ? $drops : '-')); } } if ($cisco_p) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %10s", defined $crc ? $crc : '-'); } else { $win->addstr (sprintf (" %10s", defined $crc ? $crc : '-')); } } if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %s", defined $comment ? $comment : ''); } else { $win->addstr (sprintf (" %s", defined $comment ? $comment : '')); } print "\n" if !$suppress_output and $suppress_curses; } else { my $old = $old{$index}; $interval = ($clock-$old->{'clock'}) * 1.0 / $clock_ticks; my $d_in = rate_or_0 ($old->{'in'}, $in, $interval, $counter64_p, 8); my $d_out = rate_or_0 ($old->{'out'}, $out, $interval, $counter64_p, 8); my $d_drops = rate_or_0 ($old->{'drops'}, $drops, $interval, 0); my $d_crc = rate_or_0 ($old->{'crc'}, $crc, $interval, 0); $alarm = ($d_crc != 0) || 0 && ($d_out > 0 && $d_in == 0); print STDERR "\007" if $alarm && !$old->{'alarm'}; print STDERR "\007" if !$alarm && $old->{'alarm'}; $win->standout() if $alarm && !$suppress_curses; if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT ("%5d %-24s %s %s", $index, defined $descr ? $descr : '', pretty_ps ($in, $d_in), pretty_ps ($out, $d_out)); } else { $win->addstr ($linecount, 0, sprintf ("%5d %-24s %s %s", $index, defined $descr ? $descr : '', pretty_ps ($in, $d_in), pretty_ps ($out, $d_out))); } if ($show_out_discards) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %8.1f %s", defined $drops ? $d_drops : 0); } else { $win->addstr (sprintf (" %8.1f %s", defined $drops ? $d_drops : 0)); } } if ($cisco_p) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %10.1f", defined $crc ? $d_crc : 0); } else { $win->addstr (sprintf (" %10.1f", defined $crc ? $d_crc : 0)); } } if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT (" %s", defined $comment ? $comment : ''); } else { $win->addstr (sprintf (" %s", defined $comment ? $comment : '')); } $win->standend() if $alarm && !$suppress_output; print "\n" if !$suppress_output and $suppress_curses; } $old{$index} = {'in' => $in, 'out' => $out, 'crc' => $crc, 'drops' => $drops, 'clock' => $clock, 'alarm' => $alarm}; ++$linecount; $win->refresh () unless $suppress_output; } sub out_switching_engine ($$$$$$@) { my ($index, $pkts, $octets, $candidate_flow_hits, $established_flow_hits, $active_flows, $flow_learn_failures, $int_flow_invalids, $ext_flow_invalids) = @_; my ($clock) = POSIX::times(); my $alarm = 0; grep (defined $_ && ($_=pretty_print $_), ($pkts, $octets, $candidate_flow_hits, $established_flow_hits, $active_flows, $flow_learn_failures, $int_flow_invalids, $ext_flow_invalids)); warn "RETRIEVED: pkts: $pkts\noctets: $octets\n" if $debug; $win->clrtoeol () unless $suppress_curses; return unless defined $pkts and defined $octets; ## Suppress interfaces called "unrouted VLAN..." if (!defined $old{$index}) { if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT ("%5d %10s %10s\n", $index, defined $pkts ? $pkts : '-', defined $octets ? $octets : '-'); } else { $win->addstr ($linecount, 0, sprintf ("%5d %10s %10s", $index, defined $pkts ? $pkts : '-', defined $octets ? $octets : '-')); } } else { my $old = $old{$index}; $interval = ($clock-$old->{'clock'}) * 1.0 / $clock_ticks; my $d_pkts = rate_or_0 ($old->{'pkts'}, $pkts, $interval, 0); my $d_octets = rate_or_0 ($old->{'octets'}, $octets, $interval, 1, 8); warn "RATE: pkts: $d_pkts\nbits: $d_octets\n" if $debug; $alarm = 0; print STDERR "\007" if $alarm && !$old->{'alarm'}; print STDERR "\007" if !$alarm && $old->{'alarm'}; $win->standout() if $alarm && !$suppress_curses; if ($suppress_output) { # do nothing } elsif ($suppress_curses) { printf STDOUT ("%2d %s %s", $index, pretty_ps ($pkts, $d_pkts), pretty_ps ($octets, $d_octets)); } else { $win->addstr ($linecount, 0, sprintf ("%2d %s %s", $index, pretty_ps ($pkts, $d_pkts), pretty_ps ($octets, $d_octets))); } $win->standend() if $alarm && !$suppress_curses; print "\n" if !$suppress_output and $suppress_curses; } $old{$index} = {'pkts' => $pkts, 'octets' => $octets, 'clock' => $clock, 'alarm' => $alarm}; ++$linecount; $win->refresh () unless $suppress_curses; } sub pretty_ps ($$) { my ($count, $bps) = @_; if (! defined $count) { return ' - '; } elsif ($bps > 1000000) { return sprintf ("%8.4f M", $bps/1000000); } elsif ($bps > 1000) { return sprintf ("%9.1fk", $bps/1000); } else { return sprintf ("%10.0f", $bps); } } $win->erase () unless $suppress_curses; my $session = ($version eq '1' ? SNMPv1_Session->open ($host, $community, $port, undef, undef, undef, undef, $ipv4_only_p) : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, $port, undef, undef, undef, undef, $ipv4_only_p) : die "Unknown SNMP version $version") || die "Opening SNMP_Session"; $session->debug (1) if $debug; $use_getbulk_p = 0 if $version eq '1'; $session->{'use_getbulk'} = 0 unless $use_getbulk_p; ### max_repetitions: ### ### We try to be smart about the value of $max_repetitions. Starting ### with the session default, we use the number of rows in the table ### (returned from map_table_4) to compute the next value. It should ### be one more than the number of rows in the table, because ### map_table needs an extra set of bindings to detect the end of the ### table. ### $max_repetitions = $session->default_max_repetitions unless $max_repetitions; while (1) { unless ($suppress_output) { if ($suppress_curses) { printf STDOUT ("interval: %4.1fs %d reps\n", $interval || $desired_interval, $max_repetitions); } else { $win->addstr (0, 0, sprintf ("%-20s interval %4.1fs %d reps", $host, $interval || $desired_interval, $max_repetitions)); $win->standout(); $win->addstr (1, 0, sprintf (("%5s %-24s %10s %10s"), "index", "name", "bits/s", "bits/s")); if ($show_out_discards) { $win->addstr (sprintf ((" %8s"), "drops/s")); } if ($cisco_p) { $win->addstr (sprintf ((" %10s"), "pkts/s")); } $win->addstr (sprintf ((" %s"), "description")); $win->addstr (2, 0, sprintf (("%2s %-24s %10s %10s"), "", "", "in", "out")); if ($show_out_discards) { $win->addstr (sprintf ((" %8s"), "")); } if ($cisco_p) { $win->addstr (2, 0, sprintf ((" %10s %s"), "CRC", "")); } $win->clrtoeol (); $win->standend(); } } $linecount = 3; my @oids; if ($switch_engine_p) { @oids = ( $cseL3SwitchedTotalPkts, $cseL3SwitchedTotalOctets, $cseL3CandidateFlowHits, $cseL3EstablishedFlowHits, $cseL3ActiveFlows, $cseL3FlowLearnFailures, $cseL3IntFlowInvalids, $cseL3ExtFlowInvalids ); } else { @oids = ($ifDescr,$ifAdminStatus,$ifOperStatus); if ($counter64_p) { @oids = (@oids,$ifHCInOctets,$ifHCOutOctets); } else { @oids = (@oids,$ifInOctets,$ifOutOctets); } @oids = (@oids,$ifAlias); if ($cisco_p) { push @oids, $locIfInCRC; } if ($show_out_discards) { push @oids, $ifOutDiscards; } } my $calls = $switch_engine_p ? $session->map_table_4 (\@oids, \&out_switching_engine, $max_repetitions) : $session->map_table_4 (\@oids, \&out_interface, $max_repetitions); $win->clrtobot (), $win->refresh () unless $suppress_curses; $max_repetitions = $calls + 1 if $calls > 0; $sleep_interval -= ($interval - $desired_interval) if defined $interval; select (undef, undef, undef, $sleep_interval); } 1; sub usage ($) { warn < # # Example: # capturetest myrouter:::::2 25 ifDescr ifInOctets use strict; use FindBin; use lib "/opt/mrtg-2.9.22dev/lib/mrtg2"; use SNMP_util; use BER; &main; sub main { my $router_connect = shift @ARGV; my $maxrepeaters = shift @ARGV; my @req_vars = @ARGV; my @buffer; my @result = snmpwalk($router_connect, { capture_buffer =>\@buffer, return_array_refs => 1, default_max_repetitions => $maxrepeaters }, @req_vars ); print "Result is ", (join "\n\n",(map ((join ' ', @{$_}),@result))), "\n"; print "Capture buffer contains ", (scalar @buffer), " entries.\n"; for my $entry (@buffer) { print "\n"; print pretty_print($entry), "\n"; } print "\n"; } SNMP_Session-1.13/test/arp0000755000175000017500000001072311106124642014713 0ustar leinenleinen#!/usr/local/bin/perl -w ## Name: test/arp ## Author: Simon Leinen ## Description: Dump ARP table using Perl SNMP library ###################################################################### ## Usage: arp hostname [community] ## ## Extracts HOSTNAME's network to media address table using SNMP and ## prints it to standard output. Example output (errors probably due ## to the agent): ## ## $ perl test/arp babar public ## lo0 130.59.4.11 dynamic 08:00:20:12:cc:3f ## lo0 130.59.4.22 dynamic 08:00:20:88:9a:5e ## lo0 130.59.4.30 dynamic 08:00:20:76:48:af ## lo0 130.59.4.33 dynamic 08:00:09:f7:f2:9b ## lo0 130.59.4.38 dynamic 08:00:20:86:95:57 ## lo0 130.59.4.110 dynamic 00:05:02:9c:34:1e ## lo0 130.59.4.134 dynamic 00:05:02:ec:a3:1b ## lo0 130.59.4.202 dynamic 00:00:0c:5d:05:d0 ## lo0 224.0.0.0 dynamic 01:00:5e:00:00:00 ## lo0 224.1.127.255 dynamic 01:00:5e:01:7f:ff ## lo0 224.2.127.253 dynamic 01:00:5e:02:7f:fd ## lo0 224.2.127.254 dynamic 01:00:5e:02:7f:fe ## lo0 239.255.255.255 dynamic 01:00:5e:7f:ff:ff ## hme0 130.59.4.2 dynamic 08:00:20:83:00:69 ## ## The interface name in the first column is the ifDescr value for the ## interface to which the ipNetToMediaIfIndex refers. ###################################################################### require 5.002; use strict; use SNMP_Session "0.57"; # needs map_table use BER; sub out_arp_entry ($$$); sub ether_hex ($); sub ifDescr ($$); sub usage (); # # OIDs we know by name. # my %OIDS = ( 'ipNetToMediaPhysAddress' => [1,3,6,1,2,1,4,22,1,2], 'ipNetToMediaType' => [1,3,6,1,2,1,4,22,1,4], ); my $hostname = $ARGV[0] || usage (); my $community = $ARGV[1] || "public"; my $session; die "Couldn't open SNMP session to $hostname" unless ($session = SNMP_Session->open ($hostname, $community, 161)); $session->map_table ([$OIDS{'ipNetToMediaPhysAddress'}, $OIDS{'ipNetToMediaType'}], \&out_arp_entry); $session->close (); 1; ## out_arp_entry (INDEX, PHYS_ADDRESS, TYPE) ## ## Writes a line of ARP output from a partial row of the ## ipNetToMediaTable. The does not use the ipNetToMediaIfIndex or ## ipNetToMediaNetAddress, because those can be derived from the row ## index. ## sub out_arp_entry ($$$) { my ($index, $physAddress, $type) = @_; ## the index of this table has the form IFINDEX.IPADDRESS, where ## IPADDRESS is a "dotted quad" of four integers. We simply split ## at the first dot to get the interface index and the IP address in ## readable notation: ## my ($ifIndex, $netAddress) = split(/\./, $index, 2); $type = pretty_print ($type); if ($type eq 1) { $type = "other"; } elsif ($type eq 2) { $type = "invalid"; } elsif ($type eq 3) { $type = "dynamic"; } elsif ($type eq 4) { $type = "static"; } $physAddress = ether_hex (hex_string ($physAddress)); printf STDOUT ("%-20s %-15s %-10s %s\n", ifDescr ($ifIndex, $session), $netAddress, $type, $physAddress); } ## ether_hex (HEX_STRING) ## ## Converts a raw hex representation into the common form used in ## Ethernet addresses, e.g. "080020830069" becomes ## "08:00:20:83:00:69". ## sub ether_hex ($) { my ($string) = @_; $string =~ s/([0-9a-f][0-9a-f])/$1:/g; $string =~ s/:$//; $string; } my %ifDescrCache; ## ifDescr (IFINDEX, SESSION) ## ## Return the interface description associated with the given ## IFINDEX. Uses SESSION as the destination for SNMP request. ## Results are cached in %ifDescrCache to avoid sending the same SNMP ## request more than once. ## sub ifDescr ($$) { my @ifDescr = split ('\.','1.3.6.1.2.1.2.2.1.2'); my ($ifIndex, $session) = @_; return $ifDescrCache{$ifIndex,$session} if defined ($ifDescrCache{$ifIndex,$session}); push @ifDescr,$ifIndex; if ($session->get_request_response (encode_oid (@ifDescr))) { my $response = $session->pdu_buffer; my ($bindings, $binding, $oid, $value); ($bindings) = $session->decode_get_response ($response); ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); return $ifDescrCache{$ifIndex,$session} = pretty_print ($value); } else { return "if#".$ifIndex; } } sub usage () { die "usage: $0 host [community]"; } SNMP_Session-1.13/test/sun-ps0000755000175000017500000000411011106124642015347 0ustar leinenleinen#!/usr/local/bin/perl -w ## ## Print the SNMP-accessibe portion of a Sun's process table ## in a manner similar to ps -ef. ## ## Uses the "sun-snmp" MIB according to /var/snmp/mibs/sun.mib in ## Solstice Enterprise Agents. ## use strict; use SNMP_Session; use BER; my $host = shift @ARGV || usage (1); my $community = shift @ARGV || 'public'; my $psProcessID = [1,3,6,1,4,1,42,3,12,1,1,1]; my $psParentProcessID = [1,3,6,1,4,1,42,3,12,1,1,2]; my $psProcessSize = [1,3,6,1,4,1,42,3,12,1,1,3]; my $psProcessCpuTime = [1,3,6,1,4,1,42,3,12,1,1,4]; my $psProcessState = [1,3,6,1,4,1,42,3,12,1,1,5]; my $psProcessWaitChannel = [1,3,6,1,4,1,42,3,12,1,1,6]; my $psProcessTTY = [1,3,6,1,4,1,42,3,12,1,1,7]; my $psProcessUserName = [1,3,6,1,4,1,42,3,12,1,1,8]; my $psProcessUserID = [1,3,6,1,4,1,42,3,12,1,1,9]; my $psProcessProcessName = [1,3,6,1,4,1,42,3,12,1,1,10]; my $psProcessProcessStatus = [1,3,6,1,4,1,42,3,12,1,1,11]; my $session = SNMP_Session->open ($host, $community, 161); $session->map_table ([$psProcessID, $psParentProcessID, $psProcessSize, $psProcessCpuTime, $psProcessState, $psProcessWaitChannel, $psProcessTTY, $psProcessUserName, $psProcessUserID, $psProcessProcessName, $psProcessProcessStatus], \&out_process) || warn "Problem walking process table"; $session->close () || warn "Problem closing SNMP_Session"; 1; sub out_process ($$$$$$$$$$$$) { my ($index, $pid, $ppid, $size, $cpu_time, $status, $wchan, $tty, $user_name, $user_id, $name, $process_status); $index = shift @_; grep (defined $_ && ($_=pretty_print $_), @_); ($pid, $ppid, $size, $cpu_time, $status, $wchan, $tty, $user_name, $user_id, $name, $process_status) = @_; die "PID inconsistent" unless $index == $pid; printf STDOUT ("%8s %5d %5d %5s %-8s %-20.20s\n", $user_name, $pid, $ppid, pretty_cpu_time ($cpu_time), $tty, $name); } sub pretty_cpu_time ($) { my ($time) = @_; sprintf ("%2d:%02d", $time / 60, $time % 60); } sub usage ($) { warn "usage: $0 host [community]\n"; exit $_[0] if $_[0]; } SNMP_Session-1.13/test/sun-find-process0000644000175000017500000000203611106124642017323 0ustar leinenleinen#!/usr/local/bin/perl -w ## ## Usage: find-process name host [community] ## ## List the PID(s) of processes of a given NAME running on a given ## HOST, using SNMP community COMMUNITY. ## ## Uses the "sun-snmp" MIB according to /var/snmp/mibs/sun.mib in ## Solstice Enterprise Agents. ## use strict; use SNMP_Session; use BER; my $proc_name = shift @ARGV || usage (1); my $host = shift @ARGV || usage (1); my $community = shift @ARGV || 'public'; my $psProcessID = [1,3,6,1,4,1,42,3,12,1,1,1]; my $psProcessProcessName = [1,3,6,1,4,1,42,3,12,1,1,10]; my $session = SNMP_Session->open ($host, $community, 161); $session->map_table ([$psProcessProcessName], sub { my ($index, $name); $index = shift @_; grep (defined $_ && ($_=pretty_print $_), @_); ($name) = @_; print STDOUT $index,"\n" if $name eq $proc_name; }) || warn "Problem walking process table"; $session->close () || warn "Problem closing SNMP_Session"; 1; sub usage ($) { warn "usage: $0 host [community]\n"; exit $_[0] if $_[0]; } SNMP_Session-1.13/test/if-status.pl0000755000175000017500000000653711106124642016472 0ustar leinenleinen#!/usr/local/bin/perl -w # # Small sample application for table walking # # Given a router name and SNMP community string, traverse the RFC1213 # ifTable and write a message for each interface whose ifOperStatus # differs from the ifAdminStatus. require 5.003; use strict; use lib qw(/opt/www/cgi-bin/cug/switch/snmp); use BER; use SNMP_Session; use CGI qw(:html2 :html3); ### Forward declarations sub out_interface ($$$$$ ); sub usage (); sub print_html_header ($ ); sub print_html_trailer (); my $output_mode = 'text'; my $have_html_header = 0; my ($host, $community); my $query; my $version; if (defined $ENV{'REQUEST_METHOD'}) { $output_mode = 'html'; $query = new CGI; $host = $query->param ('host'); $community = $query->param ('community'); print $query->header; } else { my $arg; while (defined $ARGV[0] and $ARGV[0] =~ /^-/) { if ($ARGV[0] =~ /^-v/) { if ($ARGV[0] eq '-v') { shift @ARGV; usage () unless defined $ARGV[0]; } else { $ARGV[0] = substr($ARGV[0], 2); } if ($ARGV[0] eq '1') { $version = '1'; } elsif ($ARGV[0] eq '2c' or $ARGV[0] eq '2') { $version = '2c'; } else { usage (); } } elsif ($arg eq '-html') { $output_mode = 'html'; } else { usage (); } shift @ARGV; } $host = shift @ARGV || die; $community = shift @ARGV || die; } my $ifDescr = [1,3,6,1,2,1,2,2,1,2]; my $ifAdminStatus = [1,3,6,1,2,1,2,2,1,7]; my $ifOperStatus = [1,3,6,1,2,1,2,2,1,8]; my $locIfDescr = [1,3,6,1,4,1,9,2,2,1,1,28]; my $the_router; sub out_interface ($$$$$) { my ($index, $descr, $admin, $oper, $comment) = @_; grep (defined $_ && ($_=pretty_print $_), ($descr, $admin, $oper, $comment)); return if defined $admin && $admin == 2; return if defined $admin && defined $oper && $admin == $oper; my $admin_string = $admin ? ($admin == 1 ? 'up' : ($admin == 2 ? 'down' : "?($admin)")) : "?"; my $oper_string = $oper ? ($oper == 1 ? 'up' : ($oper == 2 ? 'down' : "?($oper)")) : "?"; $comment = '' unless defined $comment; if ($output_mode eq 'text') { printf "%2d %-20s %10s %10s %s\n", $index, $descr, $admin_string, $oper_string, defined $comment ? $comment : ''; } elsif ($output_mode eq 'html') { print_html_header ($the_router), $have_html_header = 1 unless $have_html_header; print TR(th($index), td(CGI->escapeHTML($descr)), td({align=>'center'},$admin_string), td({align=>'center'},$oper_string), td(CGI->escapeHTML($comment))),"\n"; } } $the_router = $host; my $session = ($version eq '1' ? SNMPv1_Session->open ($host, $community, 161) : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, 161) : die "Unknown SNMP version $version") || die "Opening SNMP_Session"; $session->map_table ([$ifDescr,$ifAdminStatus,$ifOperStatus,$locIfDescr], \&out_interface); if ($output_mode eq 'html' && $have_html_header) { print_html_trailer (); } 1; sub usage () { die "Usage: $0 [-html] hostname community"; } sub print_html_header ($ ) { my ($router) = @_; print "\n"; print head(title("Interface Listing for ".$router)),"\n"; print " \n", h1("Interface Listing for ".tt($router)),"\n", " \n", TR(th("index"), th("descr"), th("admin"), th("oper"), th("description")); } sub print_html_trailer () { print "
\n \n\n"; } SNMP_Session-1.13/test/wwwtest0000755000175000017500000001214211106124642015652 0ustar leinenleinen#!/usr/bin/perl ###################################################################### ### Sample CGI script using the Perl 5 SNMP Module ### ### This script can be used as a CGI script with an HTTP Daemon, to ### allow asking SNMP queries from a World-Wide Web client. ### ###################################################################### ### When called with an empty QUERY_STRING environment variable, a ### form is generated that lets the user fill in a host and community ### name. When the filled-in form is submitted, the script will be ### called again, this time with parameters passed through ### $QUERY_STRING. It will make an SNMP query to the selected ### host/community and return the results as an HTML document ### containing an HTML 3 table which shows the names and values of ### some MIB variable instances. ###################################################################### require 5; use lib qw(/home/leinen/perl/SNMP_Session-0.96/lib /home/leinen/perl/SNMP_Session-0.96/blib/lib); use SNMP_Session; use BER; use CGI qw(:standard start_table end_table :debug); use strict; sub init_oids (); sub query_to_html_response ($$); sub snmp_get ($@); sub write_query_form (); sub html_error_message ($$); sub html_quote ($ ); my @allowed_hosts=qw(localhost ::1 127.0.0.1); my %allowed_hosts; my $community_file_name = "/home/leinen/snmp/.zxc"; my $ipv4_only_p = 0; my $home_url = "http://www.switch.ch/misc/leinen/snmp/perl/"; my (%ugly_oids, %pretty_oids); foreach (@allowed_hosts) { $allowed_hosts{$_} = 1; } my $q = new CGI; if (!defined ($q) || !defined $q->param ('hostname')) { write_query_form (); } else { init_oids (); if (! exists ($allowed_hosts{$q->param ('hostname')})) { print (header ()); html_error_message ("parsing the query", "Illegal hostname ".$q->param ('hostname')); } else { query_to_html_response ($q->param ('hostname'), $q->param ('community')); } } 1; sub init_oids () { %ugly_oids = qw(sysDescr.0 1.3.6.1.2.1.1.1.0 sysLocation.0 1.3.6.1.2.1.1.6.0 ); foreach (keys %ugly_oids) { $ugly_oids{$_} = encode_oid (split (/\./, $ugly_oids{$_})); $pretty_oids{$ugly_oids{$_}} = $_; } } sub query_to_html_response ($$) { my ($hostname, $community) = @_; my $session; if ($community eq 'public' && -r $community_file_name) { open (COMM, $community_file_name); $community = ; chomp $community; close COMM; } print (header (), start_html ("Perl SNMP Module Test"), h1 ("SNMP query to " .html_quote ($community) .'@' .html_quote ($hostname)), hr ()); srand(); eval { $session = SNMPv2c_Session->open ($hostname, $community, 161, undef, undef, undef, undef, $ipv4_only_p) }; html_error_message ("opening SNMP session", $SNMP_Session::errmsg), return 0 unless defined $session; html_error_message ("opening SNMP session", $@), return 0 if $@; eval { snmp_get ($session, qw(sysDescr.0 sysLocation.0)) }; html_error_message ("executing SNMP query", $@), return 0 if $@; $session->close (); print (end_html ()); 1; } sub snmp_get ($@) { my($session, @oids) = @_; my($response, $bindings, $binding, $value, $oid); grep ($_ = $ugly_oids{$_}, @oids); if ($session->get_request_response (@oids)) { $response = $session->pdu_buffer; ($bindings) = $session->decode_get_response ($response); print (start_table({border=>'1'})); while ($bindings ne '') { ($binding,$bindings) = decode_sequence ($bindings); ($oid,$value) = decode_by_template ($binding, "%O%@"); print Tr(th ({align=>'right'}, $pretty_oids{$oid}), td ({align=>'left'}, html_quote (pretty_print ($value)))); } print (end_table ()); 1; } else { die "No response received.\n"; } } sub write_query_form () { my $first_p = 1; my $options = join ("\n", map ({my $res = $q->option ({-selected=>$first_p, -value=>$_}, $_); $first_p = 0; $res;} @allowed_hosts)); print (header (), start_html ("Perl SNMP Module Test"), h1 ("Perl SNMP Module Test"), p ("This is a sample application of an ", a ({href => $home_url}, "SNMP Module"), "(version ${SNMP_Session::VERSION}) for Perl 5."), hr (), $q->start_form (-method=>'GET'), "Host name:\n", Select ({name => 'hostname'}, $options), "\n", "Community name:\n", Select ({name => 'community'}, option ({value => 'public'}, "public")), br (), "\n", input ({type => 'submit', value => "Send request"}), "\n", input ({type => 'reset', value => "Clear"}), "\n", $q->end_form (), hr (), "\n", address (a ({href=>"http://www.switch.ch/misc/leinen/"}, "Simon Leinen <simon\@switch.ch>")), "\n", end_html (), "\n"); } sub html_error_message ($$) { my($context, $errmsg) = @_; print ($q->h2 ("SNMP Error"), hr (), p ("While ",$context,", the following error occurred:"), pre (html_quote($errmsg)), end_html ()); } sub html_quote ($ ) { local ($_) = @_; return $_ unless /[<>&]/; s/&/&/g; s//>/g; $_; } SNMP_Session-1.13/test/ber-test.pl0000755000175000017500000001417411106124642016274 0ustar leinenleinen#!/usr/local/bin/perl -w ###################################################################### ### Name: ber-test.pl ### Date Created: Sat Feb 1 16:09:46 1997 ### Author: Simon Leinen ### RCS $Id: ber-test.pl,v 1.9 2004-02-17 21:38:56 leinen Exp $ ###################################################################### ### Regression Tests for BER encoding/decoding ###################################################################### use BER; use Carp; use integer; use strict; ## Prototypes sub regression_test (); sub encode_int_test ($$); sub decode_intlike_test ($$); sub eq_test ($$); sub equal_test ($$); sub string_hex ($ ); sub encode_int_regression_test (); my $exitcode = 0; regression_test; exit ($exitcode); #### Regression Tests sub regression_test () { eq_test ('encode_string ("public")', "\x04\x06\x70\x75\x62\x6C\x69\x63"); eq_test ('encode_ip_address ("\x82\x3b\x04\x02")', "\x40\x04\x82\x3b\x04\x02"); eq_test ('encode_ip_address ("130.59.4.2")', "\x40\x04\x82\x3b\x04\x02"); encode_int_test (0x4aec3116, "\x02\x04\x4A\xEC\x31\x16"); encode_int_test (0xec3116, "\x02\x04\x00\xEC\x31\x16"); encode_int_test (0x3c3116, "\x02\x03\x3C\x31\x16"); encode_int_test (-1234, "\x02\x02\xfb\x2e"); decode_intlike_test ('"\x02\x01\x01"', 1); decode_intlike_test ('"\x02\x01\xff"', -1); decode_intlike_test ('"\x02\x02\x01\x02"', 258); decode_intlike_test ('"\x02\x02\xff\xff"', -1); decode_intlike_test ('"\x02\x03\x00\xff\xfe"', 65534); decode_intlike_test ('"\x02\x03\xff\xff\xfd"', -3); decode_intlike_test ('"\x02\x04\x00\xff\xff\xfd"', 16777213); decode_intlike_test ('"\x02\x04\xff\xff\xff\xfc"', -4); decode_intlike_test ('"\x02\x05\x00\xff\xff\xff\xfc"', 4294967292); ## Tests for integers > 2^32 ## ## For really big integers (those that don't have an exact double ## representation, I guess), we have to write the comparands as ## strings, because otherwise they will be converted to NaN by ## Perl. The comparisons still work right thanks to Math::BigInt, ## which is used by BER.pm for large integers. ## decode_intlike_test ('"\x02\x06\x00\x01\x00\x00\x00\x00"', 4294967296); decode_intlike_test ('"\x02\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff"', "18446744073709551615"); use Math::BigInt lib => 'GMP'; { ## We have to disable warnings because of Math::BigInt ## local $^W = 0; eq_test ('encode_int (new Math::BigInt ("18446744073709551615"))', "\x02\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff"); } eq_test ('(BER::decode_string ("\x04\x06public"))[0]', "public"); eq_test ('(BER::decode_oid ("\x06\x04\x01\x03\x06\x01"))[0]', "\x06\x04\x01\x03\x06\x01"); die unless encode_int_regression_test (); } sub encode_int_test ($$) { my ($int, $encoded) = @_; eq_test ("encode_int ($int)", $encoded); } sub decode_intlike_test ($$) { my ($pdu, $wanted) = @_; equal_test ("(BER::decode_intlike ($pdu))[0]", $wanted); } sub eq_test ($$) { my ($expr, $wanted) = @_; my $result; undef $@; $result = eval $expr; croak "$@" if $@; (warn $expr." => ".string_hex ($result)." != ".string_hex ($wanted)), ++$exitcode unless $result eq $wanted; } sub equal_test ($$) { my ($expr, $wanted) = @_; my $result; undef $@; $result = eval $expr; croak "$@" if $@; (warn $expr." => ".$result." != ".$wanted), ++$exitcode unless $result == $wanted; } sub string_hex ($ ) { my $result = ''; my ($string) = @_; my ($i); for ($i = 0; $i < length $string; ++$i) { $result .= sprintf "%02x", ord (substr ($string, $i, 1)); } $result; } ### Test cases and harness kindly contributed by ### Mike Mitchell ### sub encode_int_regression_test () { my $try; my @tries = ( 0, 1, 126, 127, 128, 129, 254, 255, 256, 257, 32766, 32767, 32768, 32769, 65534, 65535, 65536, 65537, 8388606, 8388607, 8388608, 8388609, 16777214, 16777215, 16777216, 16777217, -1, -126, -127, -128, -129, -254, -255, -256, -257, -32766, -32767, -32768, -32769, -65534, -65535, -65536, -65537, -8388606, -8388607, -8388608, -8388609, -16777214, -16777215, -16777216, -16777217, 5921370, -5921370, 2147483646, 2147483647, -2147483647, -2147483648 ); my $expected = < $output" unless $output eq $wanted; } 1; } SNMP_Session-1.13/META.yml0000644000175000017500000000052111111614635014472 0ustar leinenleinen--- #YAML:1.0 name: SNMP_Session version: 1.13 abstract: ~ license: ~ author: ~ generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 SNMP_Session-1.13/Makefile.PL0000644000175000017500000000033211106124644015173 0ustar leinenleinenuse ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'SNMP_Session', 'VERSION_FROM' => 'lib/SNMP_Session.pm', # finds $VERSION 'dist' => {COMPRESS=>'gzip -9f', SUFFIX => 'gz'}, );