summaryrefslogtreecommitdiff
path: root/torrus/perllib/Torrus/DevDiscover.pm
diff options
context:
space:
mode:
Diffstat (limited to 'torrus/perllib/Torrus/DevDiscover.pm')
-rw-r--r--torrus/perllib/Torrus/DevDiscover.pm1106
1 files changed, 1106 insertions, 0 deletions
diff --git a/torrus/perllib/Torrus/DevDiscover.pm b/torrus/perllib/Torrus/DevDiscover.pm
new file mode 100644
index 000000000..b6ee8eef8
--- /dev/null
+++ b/torrus/perllib/Torrus/DevDiscover.pm
@@ -0,0 +1,1106 @@
+# Copyright (C) 2002-2010 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: DevDiscover.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# Core SNMP device discovery module
+
+package Torrus::DevDiscover::DevDetails;
+
+package Torrus::DevDiscover;
+
+use strict;
+use POSIX qw(strftime);
+use Net::SNMP qw(:snmp :asn1);
+use Digest::MD5 qw(md5);
+
+use Torrus::Log;
+
+BEGIN
+{
+ foreach my $mod ( @Torrus::DevDiscover::loadModules )
+ {
+ eval( 'require ' . $mod );
+ die( $@ ) if $@;
+ }
+}
+
+# Custom overlays for templates
+# overlayName ->
+# 'Module::templateName' -> { 'name' => 'templateName',
+# 'source' => 'filename.xml' }
+our %templateOverlays;
+
+our @requiredParams =
+ (
+ 'snmp-port',
+ 'snmp-version',
+ 'snmp-timeout',
+ 'snmp-retries',
+ 'data-dir',
+ 'snmp-host'
+ );
+
+our %defaultParams;
+
+$defaultParams{'rrd-hwpredict'} = 'no';
+$defaultParams{'domain-name'} = '';
+$defaultParams{'host-subtree'} = '';
+$defaultParams{'snmp-check-sysuptime'} = 'yes';
+$defaultParams{'show-recursive'} = 'yes';
+$defaultParams{'snmp-ipversion'} = '4';
+$defaultParams{'snmp-transport'} = 'udp';
+
+our @copyParams =
+ ( 'collector-period',
+ 'collector-timeoffset',
+ 'collector-dispersed-timeoffset',
+ 'collector-timeoffset-min',
+ 'collector-timeoffset-max',
+ 'collector-timeoffset-step',
+ 'comment',
+ 'domain-name',
+ 'monitor-period',
+ 'monitor-timeoffset',
+ 'nodeid-device',
+ 'show-recursive',
+ 'snmp-host',
+ 'snmp-port',
+ 'snmp-localaddr',
+ 'snmp-localport',
+ 'snmp-ipversion',
+ 'snmp-transport',
+ 'snmp-community',
+ 'snmp-version',
+ 'snmp-username',
+ 'snmp-authkey',
+ 'snmp-authpassword',
+ 'snmp-authprotocol',
+ 'snmp-privkey',
+ 'snmp-privpassword',
+ 'snmp-privprotocol',
+ 'snmp-timeout',
+ 'snmp-retries',
+ 'snmp-oids-per-pdu',
+ 'snmp-check-sysuptime',
+ 'snmp-max-msg-size',
+ 'system-id' );
+
+
+%Torrus::DevDiscover::oiddef =
+ (
+ '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',
+ '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'
+ );
+
+my @systemOIDs = ('sysDescr', 'sysObjectID', 'sysUpTime', 'sysContact',
+ 'sysName', 'sysLocation');
+
+sub new
+{
+ my $self = {};
+ my $class = shift;
+ my %options = @_;
+ bless $self, $class;
+
+ $self->{'oiddef'} = {};
+ $self->{'oidrev'} = {};
+
+ # Combine all %MODULE::oiddef hashes into one
+ foreach my $module ( 'Torrus::DevDiscover',
+ @Torrus::DevDiscover::loadModules )
+ {
+ while( my($name, $oid) = each %{eval('\%'.$module.'::oiddef')} )
+ {
+ die( $@ ) if $@;
+ $self->{'oiddef'}->{$name} = $oid;
+ $self->{'oidrev'}->{$oid} = $name;
+ }
+ }
+
+ $self->{'datadirs'} = {};
+ $self->{'globalData'} = {};
+
+ return $self;
+}
+
+
+
+sub globalData
+{
+ my $self = shift;
+ return $self->{'globalData'};
+}
+
+
+sub discover
+{
+ my $self = shift;
+ my @paramhashes = @_;
+
+ my $devdetails = new Torrus::DevDiscover::DevDetails();
+
+ foreach my $params ( \%defaultParams, @paramhashes )
+ {
+ $devdetails->setParams( $params );
+ }
+
+ foreach my $param ( @requiredParams )
+ {
+ if( not defined( $devdetails->param( $param ) ) )
+ {
+ Error('Required parameter not defined: ' . $param);
+ return 0;
+ }
+ }
+
+ my %snmpargs;
+ my $community;
+
+ my $version = $devdetails->param( 'snmp-version' );
+ $snmpargs{'-version'} = $version;
+
+ foreach my $arg ( qw(-port -localaddr -localport -timeout -retries) )
+ {
+ if( defined( $devdetails->param( 'snmp' . $arg ) ) )
+ {
+ $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
+ }
+ }
+
+ $snmpargs{'-domain'} = $devdetails->param('snmp-transport') . '/ipv' .
+ $devdetails->param('snmp-ipversion');
+
+ if( $version eq '1' or $version eq '2c' )
+ {
+ $community = $devdetails->param( 'snmp-community' );
+ if( not defined( $community ) )
+ {
+ Error('Required parameter not defined: snmp-community');
+ return 0;
+ }
+ $snmpargs{'-community'} = $community;
+
+ # set maxMsgSize to a maximum value for better compatibility
+
+ my $maxmsgsize = $devdetails->param('snmp-max-msg-size');
+ if( defined( $maxmsgsize ) )
+ {
+ $devdetails->setParam('snmp-max-msg-size', $maxmsgsize);
+ $snmpargs{'-maxmsgsize'} = $maxmsgsize;
+ }
+ }
+ elsif( $version eq '3' )
+ {
+ foreach my $arg ( qw(-username -authkey -authpassword -authprotocol
+ -privkey -privpassword -privprotocol) )
+ {
+ if( defined $devdetails->param( 'snmp' . $arg ) )
+ {
+ $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
+ }
+ }
+ $community = $snmpargs{'-username'};
+ if( not defined( $community ) )
+ {
+ Error('Required parameter not defined: snmp-user');
+ return 0;
+ }
+ }
+ else
+ {
+ Error('Illegal value for snmp-version parameter: ' . $version);
+ return 0;
+ }
+
+ my $hostname = $devdetails->param('snmp-host');
+ my $domain = $devdetails->param('domain-name');
+
+ if( $domain and index($hostname, '.') < 0 and index($hostname, ':') < 0 )
+ {
+ $hostname .= '.' . $domain;
+ }
+ $snmpargs{'-hostname'} = $hostname;
+
+ my $port = $snmpargs{'-port'};
+ Debug('Discovering host: ' . $hostname . ':' . $port . ':' . $community);
+
+ my ($session, $error) =
+ Net::SNMP->session( %snmpargs,
+ -nonblocking => 0,
+ -translate => ['-all', 0, '-octetstring', 1] );
+ if( not defined($session) )
+ {
+ Error('Cannot create SNMP session: ' . $error);
+ return undef;
+ }
+
+ my @oids = ();
+ foreach my $var ( @systemOIDs )
+ {
+ push( @oids, $self->oiddef( $var ) );
+ }
+
+ # This is the only checking if the remote agent is alive
+
+ my $result = $session->get_request( -varbindlist => \@oids );
+ if( defined $result )
+ {
+ $devdetails->storeSnmpVars( $result );
+ }
+ else
+ {
+ # When the remote agent is reacheable, but system objecs are
+ # not implemented, we get a positive error_status
+ if( $session->error_status() == 0 )
+ {
+ Error("Unable to communicate with SNMP agent on " . $hostname .
+ ':' . $port . ':' . $community . " - " . $session->error());
+ return undef;
+ }
+ }
+
+ my $data = $devdetails->data();
+ $data->{'param'} = {};
+
+ $data->{'templates'} = [];
+ my $customTmpl = $devdetails->param('custom-host-templates');
+ if( length( $customTmpl ) > 0 )
+ {
+ push( @{$data->{'templates'}}, split( /\s*,\s*/, $customTmpl ) );
+ }
+
+ # Build host-level legend
+ my %legendValues =
+ (
+ 10 => {
+ 'name' => 'Location',
+ 'value' => $devdetails->snmpVar($self->oiddef('sysLocation'))
+ },
+ 20 => {
+ 'name' => 'Contact',
+ 'value' => $devdetails->snmpVar($self->oiddef('sysContact'))
+ },
+ 30 => {
+ 'name' => 'System ID',
+ 'value' => $devdetails->param('system-id')
+ },
+ 50 => {
+ 'name' => 'Description',
+ 'value' => $devdetails->snmpVar($self->oiddef('sysDescr'))
+ }
+ );
+
+ if( defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
+ {
+ $legendValues{40}{'name'} = 'Uptime';
+ $legendValues{40}{'value'} =
+ sprintf("%d days since %s",
+ $devdetails->snmpVar($self->oiddef('sysUpTime')) /
+ (100*3600*24),
+ strftime($Torrus::DevDiscover::timeFormat,
+ localtime(time())));
+ }
+
+ my $legend = '';
+ foreach my $key ( sort keys %legendValues )
+ {
+ my $text = $legendValues{$key}{'value'};
+ if( length( $text ) > 0 )
+ {
+ $text = $devdetails->screenSpecialChars( $text );
+ $legend .= $legendValues{$key}{'name'} . ':' . $text . ';';
+ }
+ }
+
+ if( $devdetails->param('suppress-legend') ne 'yes' )
+ {
+ $data->{'param'}{'legend'} = $legend;
+ }
+
+ # some parameters need just one-to-one copying
+
+ my @hostCopyParams =
+ split('\s*,\s*', $devdetails->param('host-copy-params'));
+
+ foreach my $param ( @copyParams, @hostCopyParams )
+ {
+ my $val = $devdetails->param( $param );
+ if( length( $val ) > 0 )
+ {
+ $data->{'param'}{$param} = $val;
+ }
+ }
+
+ # If snmp-host is ipv6 address, system-id needs to be adapted to
+ # remove colons
+
+ if( not defined( $data->{'param'}{'system-id'} ) and
+ index($data->{'param'}{'snmp-host'}, ':') >= 0 )
+ {
+ my $systemid = $data->{'param'}{'snmp-host'};
+ $systemid =~ s/:/_/g;
+ $data->{'param'}{'system-id'} = $systemid;
+ }
+
+ if( not defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
+ {
+ Debug('Agent does not support sysUpTime');
+ $data->{'param'}{'snmp-check-sysuptime'} = 'no';
+ }
+
+ $data->{'param'}{'data-dir'} =
+ $self->genDataDir( $devdetails->param('data-dir'), $hostname );
+
+ # Register the directory for listDataDirs()
+ $self->{'datadirs'}{$devdetails->param('data-dir')} = 1;
+
+ $self->{'session'} = $session;
+
+ # some discovery modules need to be disabled on per-device basis
+
+ my %onlyDevtypes;
+ my $useOnlyDevtypes = 0;
+ foreach my $devtype ( split('\s*,\s*',
+ $devdetails->param('only-devtypes') ) )
+ {
+ $onlyDevtypes{$devtype} = 1;
+ $useOnlyDevtypes = 1;
+ }
+
+ my %disabledDevtypes;
+ foreach my $devtype ( split('\s*,\s*',
+ $devdetails->param('disable-devtypes') ) )
+ {
+ $disabledDevtypes{$devtype} = 1;
+ }
+
+ # 'checkdevtype' procedures for each known device type return true
+ # when it's their device. They also research the device capabilities.
+ my $reg = \%Torrus::DevDiscover::registry;
+ foreach my $devtype
+ ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+ keys %{$reg} )
+ {
+ if( ( not $useOnlyDevtypes or $onlyDevtypes{$devtype} ) and
+ not $disabledDevtypes{$devtype} and
+ &{$reg->{$devtype}{'checkdevtype'}}($self, $devdetails) )
+ {
+ $devdetails->setDevType( $devtype );
+ Debug('Found device type: ' . $devtype);
+ }
+ }
+
+ my @devtypes = sort {
+ $reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}
+ } $devdetails->getDevTypes();
+ $data->{'param'}{'devdiscover-devtypes'} = join(',', @devtypes);
+
+ $data->{'param'}{'devdiscover-nodetype'} = '::device';
+
+ # Do the detailed discovery and prepare data
+ my $ok = 1;
+ foreach my $devtype ( @devtypes )
+ {
+ $ok = &{$reg->{$devtype}{'discover'}}($self, $devdetails) ? $ok:0;
+ }
+
+ delete $self->{'session'};
+ $session->close();
+
+ $devdetails->applySelectors();
+
+ my $subtree = $devdetails->param('host-subtree');
+ if( not defined( $self->{'devdetails'}{$subtree} ) )
+ {
+ $self->{'devdetails'}{$subtree} = [];
+ }
+ push( @{$self->{'devdetails'}{$subtree}}, $devdetails );
+
+ my $define_tokensets = $devdetails->param('define-tokensets');
+ if( defined( $define_tokensets ) and length( $define_tokensets ) > 0 )
+ {
+ foreach my $pair ( split(/\s*;\s*/, $define_tokensets ) )
+ {
+ my( $tset, $description ) = split( /\s*:\s*/, $pair );
+ if( $tset !~ /^[a-z][a-z0-9-_]*$/ )
+ {
+ Error('Invalid name for tokenset: ' . $tset);
+ $ok = 0;
+ }
+ elsif( length( $description ) == 0 )
+ {
+ Error('Missing description for tokenset: ' . $tset);
+ $ok = 0;
+ }
+ else
+ {
+ $self->{'define-tokensets'}{$tset} = $description;
+ }
+ }
+ }
+ return $ok;
+}
+
+
+sub buildConfig
+{
+ my $self = shift;
+ my $cb = shift;
+
+ my $reg = \%Torrus::DevDiscover::registry;
+
+ foreach my $subtree ( sort keys %{$self->{'devdetails'}} )
+ {
+ # Chop the first and last slashes
+ my $path = $subtree;
+ $path =~ s/^\///;
+ $path =~ s/\/$//;
+
+ # generate subtree path XML
+ my $subtreeNode = undef;
+ foreach my $subtreeName ( split( '/', $path ) )
+ {
+ $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName );
+ }
+
+ foreach my $devdetails
+ ( sort {$a->param('snmp-host') cmp $b->param('snmp-host')}
+ @{$self->{'devdetails'}{$subtree}} )
+ {
+
+ my $data = $devdetails->data();
+
+ my @registryOverlays = ();
+ if( defined( $devdetails->param('template-registry-overlays' ) ) )
+ {
+ my @overlayNames =
+ split(/\s*,\s*/,
+ $devdetails->param('template-registry-overlays' ));
+ foreach my $overlayName ( @overlayNames )
+ {
+ if( defined( $templateOverlays{$overlayName}) )
+ {
+ push( @registryOverlays,
+ $templateOverlays{$overlayName} );
+ }
+ else
+ {
+ Error('Cannot find the template overlay named ' .
+ $overlayName);
+ }
+ }
+ }
+
+ # we should call this anyway, in order to flush the overlays
+ # set by previous host
+ $cb->setRegistryOverlays( @registryOverlays );
+
+ if( $devdetails->param('disable-snmpcollector' ) eq 'yes' )
+ {
+ push( @{$data->{'templates'}}, '::viewonly-defaults' );
+ }
+ else
+ {
+ push( @{$data->{'templates'}}, '::snmp-defaults' );
+ }
+
+ if( $devdetails->param('rrd-hwpredict' ) eq 'yes' )
+ {
+ push( @{$data->{'templates'}}, '::holt-winters-defaults' );
+ }
+
+
+ my $devNodeName = $devdetails->param('symbolic-name');
+ if( length( $devNodeName ) == 0 )
+ {
+ $devNodeName = $devdetails->param('system-id');
+ if( length( $devNodeName ) == 0 )
+ {
+ $devNodeName = $devdetails->param('snmp-host');
+ }
+ }
+
+ my $devNode = $cb->addSubtree( $subtreeNode, $devNodeName,
+ $data->{'param'},
+ $data->{'templates'} );
+
+ my $aliases = $devdetails->param('host-aliases');
+ if( length( $aliases ) > 0 )
+ {
+ foreach my $alias ( split( '\s*,\s*', $aliases ) )
+ {
+ $cb->addAlias( $devNode, $alias );
+ }
+ }
+
+ my $includeFiles = $devdetails->param('include-files');
+ if( length( $includeFiles ) > 0 )
+ {
+ foreach my $file ( split( '\s*,\s*', $includeFiles ) )
+ {
+ $cb->addFileInclusion( $file );
+ }
+ }
+
+
+ # Let the device type-specific modules add children
+ # to the subtree
+ foreach my $devtype
+ ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+ $devdetails->getDevTypes() )
+ {
+ &{$reg->{$devtype}{'buildConfig'}}
+ ( $devdetails, $cb, $devNode, $self->{'globalData'} );
+ }
+
+ $cb->{'statistics'}{'hosts'}++;
+ }
+ }
+
+ foreach my $devtype
+ ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
+ keys %{$reg} )
+ {
+ if( defined( $reg->{$devtype}{'buildGlobalConfig'} ) )
+ {
+ &{$reg->{$devtype}{'buildGlobalConfig'}}($cb,
+ $self->{'globalData'});
+ }
+ }
+
+ if( defined( $self->{'define-tokensets'} ) )
+ {
+ my $tsetsNode = $cb->startTokensets();
+ foreach my $tset ( sort keys %{$self->{'define-tokensets'}} )
+ {
+ $cb->addTokenset( $tsetsNode, $tset, {
+ 'comment' => $self->{'define-tokensets'}{$tset} } );
+ }
+ }
+}
+
+
+
+sub session
+{
+ my $self = shift;
+ return $self->{'session'};
+}
+
+sub oiddef
+{
+ my $self = shift;
+ my $var = shift;
+
+ my $ret = $self->{'oiddef'}->{$var};
+ if( not $ret )
+ {
+ Error('Undefined OID definition: ' . $var);
+ }
+ return $ret;
+}
+
+
+sub oidref
+{
+ my $self = shift;
+ my $oid = shift;
+ return $self->{'oidref'}->{$oid};
+}
+
+
+sub genDataDir
+{
+ my $self = shift;
+ my $basedir = shift;
+ my $hostname = shift;
+
+ if( $Torrus::DevDiscover::hashDataDirEnabled )
+ {
+ return $basedir . '/' .
+ sprintf( $Torrus::DevDiscover::hashDataDirFormat,
+ unpack('N', md5($hostname)) %
+ $Torrus::DevDiscover::hashDataDirBucketSize );
+ }
+ else
+ {
+ return $basedir;
+ }
+}
+
+
+sub listDataDirs
+{
+ my $self = shift;
+
+ my @basedirs = keys %{$self->{'datadirs'}};
+ my @ret = @basedirs;
+
+ if( $Torrus::DevDiscover::hashDataDirEnabled )
+ {
+ foreach my $basedir ( @basedirs )
+ {
+ for( my $i = 0;
+ $i < $Torrus::DevDiscover::hashDataDirBucketSize;
+ $i++ )
+ {
+ push( @ret, $basedir . '/' .
+ sprintf( $Torrus::DevDiscover::hashDataDirFormat, $i ) );
+ }
+ }
+ }
+ return @ret;
+}
+
+##
+# Check if SNMP table is present, without retrieving the whole table
+
+sub checkSnmpTable
+{
+ my $self = shift;
+ my $oidname = shift;
+
+ my $session = $self->session();
+ my $oid = $self->oiddef( $oidname );
+
+ my $result = $session->get_next_request( -varbindlist => [ $oid ] );
+ if( defined( $result ) )
+ {
+ # check if the returned oid shares the base of the query
+ my $firstOid = (keys %{$result})[0];
+ if( Net::SNMP::oid_base_match( $oid, $firstOid ) and
+ length( $result->{$firstOid} ) > 0 )
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+##
+# Check if given OID is present
+
+sub checkSnmpOID
+{
+ my $self = shift;
+ my $oidname = shift;
+
+ my $session = $self->session();
+ my $oid = $self->oiddef( $oidname );
+
+ my $result = $session->get_request( -varbindlist => [ $oid ] );
+ if( $session->error_status() == 0 and
+ defined($result) and
+ defined($result->{$oid}) and
+ length($result->{$oid}) > 0 )
+ {
+ return 1;
+ }
+ return 0;
+}
+
+
+##
+# retrieve the given OIDs by names and return hash with values
+
+sub retrieveSnmpOIDs
+{
+ my $self = shift;
+ my @oidnames = @_;
+
+ my $session = $self->session();
+ my $oids = [];
+ foreach my $oidname ( @oidnames )
+ {
+ push( @{$oids}, $self->oiddef( $oidname ) );
+ }
+
+ my $result = $session->get_request( -varbindlist => $oids );
+ if( $session->error_status() == 0 and defined( $result ) )
+ {
+ my $ret = {};
+ foreach my $oidname ( @oidnames )
+ {
+ $ret->{$oidname} = $result->{$self->oiddef( $oidname )};
+ }
+ return $ret;
+ }
+ return undef;
+}
+
+##
+# Simple wrapper for Net::SNMP::oid_base_match
+
+sub oidBaseMatch
+{
+ my $self = shift;
+ my $base_oid = shift;
+ my $oid = shift;
+
+ if( $base_oid =~ /^\D/ )
+ {
+ $base_oid = $self->oiddef( $base_oid );
+ }
+ return Net::SNMP::oid_base_match( $base_oid, $oid );
+}
+
+##
+# some discovery modules need to adjust max-msg-size
+
+sub setMaxMsgSize
+{
+ my $self = shift;
+ my $devdetails = shift;
+ my $msgsize = shift;
+ my $opt = shift;
+
+ $opt = {} unless defined($opt);
+
+ if( (not $opt->{'only_v1_and_v2'}) or $self->session()->version() != 3 )
+ {
+ $self->session()->max_msg_size($msgsize);
+ $devdetails->data()->{'param'}{'snmp-max-msg-size'} = $msgsize;
+ }
+}
+
+
+
+
+###########################################################################
+#### Torrus::DevDiscover::DevDetails: the information container for a device
+####
+
+package Torrus::DevDiscover::DevDetails;
+
+use strict;
+use Torrus::RPN;
+use Torrus::Log;
+
+sub new
+{
+ my $self = {};
+ my $class = shift;
+ bless $self, $class;
+
+ $self->{'params'} = {};
+ $self->{'snmpvars'} = {}; # SNMP results stored here
+ $self->{'devtype'} = {}; # Device types
+ $self->{'caps'} = {}; # Device capabilities
+ $self->{'data'} = {}; # Discovery data
+
+ return $self;
+}
+
+
+sub setParams
+{
+ my $self = shift;
+ my $params = shift;
+
+ while( my ($param, $value) = each %{$params} )
+ {
+ $self->{'params'}->{$param} = $value;
+ }
+}
+
+
+sub setParam
+{
+ my $self = shift;
+ my $param = shift;
+ my $value = shift;
+
+ $self->{'params'}->{$param} = $value;
+}
+
+
+sub param
+{
+ my $self = shift;
+ my $name = shift;
+ return $self->{'params'}->{$name};
+}
+
+
+##
+# store the query results for later use
+
+sub storeSnmpVars
+{
+ my $self = shift;
+ my $vars = shift;
+
+ while( my( $oid, $value ) = each %{$vars} )
+ {
+ if( $oid !~ /^\d[0-9.]+\d$/o )
+ {
+ Error("Invalid OID syntax: '$oid'");
+ }
+ else
+ {
+ $self->{'snmpvars'}{$oid} = $value;
+
+ while( length( $oid ) > 0 )
+ {
+ $oid =~ s/\d+$//o;
+ $oid =~ s/\.$//o;
+ if( not exists( $self->{'snmpvars'}{$oid} ) )
+ {
+ $self->{'snmpvars'}{$oid} = undef;
+ }
+ }
+ }
+ }
+
+ # Clean the cache of sorted OIDs
+ $self->{'sortedoids'} = undef;
+}
+
+##
+# check if the stored query results have such OID prefix
+
+sub hasOID
+{
+ my $self = shift;
+ my $oid = shift;
+
+ my $found = 0;
+ if( exists( $self->{'snmpvars'}{$oid} ) )
+ {
+ $found = 1;
+ }
+ return $found;
+}
+
+##
+# get the value of stored SNMP variable
+
+sub snmpVar
+{
+ my $self = shift;
+ my $oid = shift;
+ return $self->{'snmpvars'}{$oid};
+}
+
+##
+# get the list of table indices for the specified prefix
+
+sub getSnmpIndices
+{
+ my $self = shift;
+ my $prefix = shift;
+
+ # Remember the sorted OIDs, as sorting is quite expensive for large
+ # arrays.
+
+ if( not defined( $self->{'sortedoids'} ) )
+ {
+ $self->{'sortedoids'} = [];
+ push( @{$self->{'sortedoids'}},
+ Net::SNMP::oid_lex_sort( keys %{$self->{'snmpvars'}} ) );
+ }
+
+ my @ret;
+ my $prefixLen = length( $prefix ) + 1;
+ my $matched = 0;
+
+ foreach my $oid ( @{$self->{'sortedoids'}} )
+ {
+ if( defined($self->{'snmpvars'}{$oid} ) )
+ {
+ if( Net::SNMP::oid_base_match( $prefix, $oid ) )
+ {
+ # Extract the index from OID
+ my $index = substr( $oid, $prefixLen );
+ push( @ret, $index );
+ $matched = 1;
+ }
+ elsif( $matched )
+ {
+ last;
+ }
+ }
+ }
+ return @ret;
+}
+
+
+##
+# device type is the registered discovery module name
+
+sub setDevType
+{
+ my $self = shift;
+ my $type = shift;
+ $self->{'devtype'}{$type} = 1;
+}
+
+sub isDevType
+{
+ my $self = shift;
+ my $type = shift;
+ return $self->{'devtype'}{$type};
+}
+
+sub getDevTypes
+{
+ my $self = shift;
+ return keys %{$self->{'devtype'}};
+}
+
+##
+# device capabilities. Each discovery module may define its own set of
+# capabilities and use them for information exchange between checkdevtype(),
+# discover(), and buildConfig() of its own and dependant modules
+
+sub setCap
+{
+ my $self = shift;
+ my $cap = shift;
+ Debug('Device capability: ' . $cap);
+ $self->{'caps'}{$cap} = 1;
+}
+
+sub hasCap
+{
+ my $self = shift;
+ my $cap = shift;
+ return $self->{'caps'}{$cap};
+}
+
+sub clearCap
+{
+ my $self = shift;
+ my $cap = shift;
+ Debug('Clearing device capability: ' . $cap);
+ if( exists( $self->{'caps'}{$cap} ) )
+ {
+ delete $self->{'caps'}{$cap};
+ }
+}
+
+
+
+sub data
+{
+ my $self = shift;
+ return $self->{'data'};
+}
+
+
+sub screenSpecialChars
+{
+ my $self = shift;
+ my $txt = shift;
+
+ $txt =~ s/:/{COLON}/gm;
+ $txt =~ s/;/{SEMICOL}/gm;
+ $txt =~ s/%/{PERCENT}/gm;
+
+ return $txt;
+}
+
+
+sub applySelectors
+{
+ my $self = shift;
+
+ my $selList = $self->param('selectors');
+ return if not defined( $selList );
+
+ my $reg = \%Torrus::DevDiscover::selectorsRegistry;
+
+ foreach my $sel ( split('\s*,\s*', $selList) )
+ {
+ my $type = $self->param( $sel . '-selector-type' );
+ if( not defined( $type ) )
+ {
+ Error('Parameter ' . $sel . '-selector-type must be defined ' .
+ 'for ' . $self->param('snmp-host'));
+ }
+ elsif( not exists( $reg->{$type} ) )
+ {
+ Error('Unknown selector type: ' . $type .
+ ' for ' . $self->param('snmp-host'));
+ }
+ else
+ {
+ Debug('Initializing selector: ' . $sel);
+
+ my $treg = $reg->{$type};
+ my @objects = &{$treg->{'getObjects'}}( $self, $type );
+
+ foreach my $object ( @objects )
+ {
+ Debug('Checking object: ' .
+ &{$treg->{'getObjectName'}}( $self, $object, $type ));
+
+ my $expr = $self->param( $sel . '-selector-expr' );
+ $expr = '1' if length( $expr ) == 0;
+
+ my $callback = sub
+ {
+ my $attr = shift;
+ my $checkval = $self->param( $sel . '-' . $attr );
+
+ Debug('Checking attribute: ' . $attr .
+ ' and value: ' . $checkval);
+ my $ret = &{$treg->{'checkAttribute'}}( $self,
+ $object, $type,
+ $attr, $checkval );
+ Debug(sprintf('Returned value: %d', $ret));
+ return $ret;
+ };
+
+ my $rpn = new Torrus::RPN;
+ my $result = $rpn->run( $expr, $callback );
+ Debug('Selector result: ' . $result);
+ if( $result )
+ {
+ my $actions = $self->param( $sel . '-selector-actions' );
+ foreach my $action ( split('\s*,\s*', $actions) )
+ {
+ my $arg =
+ $self->param( $sel . '-' . $action . '-arg' );
+ $arg = 1 if not defined( $arg );
+
+ Debug('Applying action: ' . $action .
+ ' with argument: ' . $arg);
+ &{$treg->{'applyAction'}}( $self, $object, $type,
+ $action, $arg );
+ }
+ }
+ }
+ }
+ }
+}
+
+1;
+
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 17:02:42 +0000