torrus/perllib/Torrus/DevDiscover.pm

   1 #  Copyright (C) 2002-2010  Stanislav Sinyagin
   2 #
   3 #  This program is free software; you can redistribute it and/or modify
   4 #  it under the terms of the GNU General Public License as published by
   5 #  the Free Software Foundation; either version 2 of the License, or
   6 #  (at your option) any later version.
   7 #
   8 #  This program is distributed in the hope that it will be useful,
   9 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #  GNU General Public License for more details.
  12 #
  13 #  You should have received a copy of the GNU General Public License
  14 #  along with this program; if not, write to the Free Software
  15 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # $Id: DevDiscover.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20 # Core SNMP device discovery module
  21
  22 package Torrus::DevDiscover::DevDetails;
  23
  24 package Torrus::DevDiscover;
  25
  26 use strict;
  27 use POSIX qw(strftime);
  28 use Net::SNMP qw(:snmp :asn1);
  29 use Digest::MD5 qw(md5);
  30
  31 use Torrus::Log;
  32
  33 BEGIN
  34 {
  35     foreach my $mod ( @Torrus::DevDiscover::loadModules )
  36     {
  37         eval( 'require ' . $mod );
  38         die( $@ ) if $@;
  39     }
  40 }
  41
  42 # Custom overlays for templates
  43 # overlayName ->
  44 #     'Module::templateName' -> { 'name' => 'templateName',
  45 #                                 'source' => 'filename.xml' }
  46 our %templateOverlays;
  47
  48 our @requiredParams =
  49     (
  50      'snmp-port',
  51      'snmp-version',
  52      'snmp-timeout',
  53      'snmp-retries',
  54      'data-dir',
  55      'snmp-host'
  56      );
  57
  58 our %defaultParams;
  59
  60 $defaultParams{'rrd-hwpredict'} = 'no';
  61 $defaultParams{'domain-name'} = '';
  62 $defaultParams{'host-subtree'} = '';
  63 $defaultParams{'snmp-check-sysuptime'} = 'yes';
  64 $defaultParams{'show-recursive'} = 'yes';
  65 $defaultParams{'snmp-ipversion'} = '4';
  66 $defaultParams{'snmp-transport'} = 'udp';
  67
  68 our @copyParams =
  69     ( 'collector-period',
  70       'collector-timeoffset',
  71       'collector-dispersed-timeoffset',
  72       'collector-timeoffset-min',
  73       'collector-timeoffset-max',
  74       'collector-timeoffset-step',
  75       'comment',
  76       'domain-name',
  77       'monitor-period',
  78       'monitor-timeoffset',
  79       'nodeid-device',
  80       'show-recursive',
  81       'snmp-host',
  82       'snmp-port',
  83       'snmp-localaddr',
  84       'snmp-localport',
  85       'snmp-ipversion',
  86       'snmp-transport',
  87       'snmp-community',
  88       'snmp-version',
  89       'snmp-username',
  90       'snmp-authkey',
  91       'snmp-authpassword',
  92       'snmp-authprotocol',
  93       'snmp-privkey',
  94       'snmp-privpassword',
  95       'snmp-privprotocol',
  96       'snmp-timeout',
  97       'snmp-retries',
  98       'snmp-oids-per-pdu',
  99       'snmp-check-sysuptime',
 100       'snmp-max-msg-size',
 101       'system-id' );
 102
 103
 104 %Torrus::DevDiscover::oiddef =
 105     (
 106      'system'         => '1.3.6.1.2.1.1',
 107      'sysDescr'       => '1.3.6.1.2.1.1.1.0',
 108      'sysObjectID'    => '1.3.6.1.2.1.1.2.0',
 109      'sysUpTime'      => '1.3.6.1.2.1.1.3.0',
 110      'sysContact'     => '1.3.6.1.2.1.1.4.0',
 111      'sysName'        => '1.3.6.1.2.1.1.5.0',
 112      'sysLocation'    => '1.3.6.1.2.1.1.6.0'
 113      );
 114
 115 my @systemOIDs = ('sysDescr', 'sysObjectID', 'sysUpTime', 'sysContact',
 116                   'sysName', 'sysLocation');
 117
 118 sub new
 119 {
 120     my $self = {};
 121     my $class = shift;
 122     my %options = @_;
 123     bless $self, $class;
 124
 125     $self->{'oiddef'} = {};
 126     $self->{'oidrev'} = {};
 127
 128     # Combine all %MODULE::oiddef hashes into one
 129     foreach my $module ( 'Torrus::DevDiscover',
 130                          @Torrus::DevDiscover::loadModules )
 131     {
 132         while( my($name, $oid) = each %{eval('\%'.$module.'::oiddef')} )
 133         {
 134             die( $@ ) if $@;
 135             $self->{'oiddef'}->{$name} = $oid;
 136             $self->{'oidrev'}->{$oid} = $name;
 137         }
 138     }
 139
 140     $self->{'datadirs'} = {};
 141     $self->{'globalData'} = {};
 142
 143     return $self;
 144 }
 145
 146
 147
 148 sub globalData
 149 {
 150     my $self = shift;
 151     return $self->{'globalData'};
 152 }
 153
 154
 155 sub discover
 156 {
 157     my $self = shift;
 158     my @paramhashes = @_;
 159
 160     my $devdetails = new Torrus::DevDiscover::DevDetails();
 161
 162     foreach my $params ( \%defaultParams, @paramhashes )
 163     {
 164         $devdetails->setParams( $params );
 165     }
 166
 167     foreach my $param ( @requiredParams )
 168     {
 169         if( not defined( $devdetails->param( $param ) ) )
 170         {
 171             Error('Required parameter not defined: ' . $param);
 172             return 0;
 173         }
 174     }
 175
 176     my %snmpargs;
 177     my $community;
 178
 179     my $version = $devdetails->param( 'snmp-version' );
 180     $snmpargs{'-version'} = $version;
 181
 182     foreach my $arg ( qw(-port -localaddr -localport -timeout -retries) )
 183     {
 184         if( defined( $devdetails->param( 'snmp' . $arg ) ) )
 185         {
 186             $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
 187         }
 188     }
 189
 190     $snmpargs{'-domain'} = $devdetails->param('snmp-transport') . '/ipv' .
 191         $devdetails->param('snmp-ipversion');
 192
 193     if( $version eq '1' or $version eq '2c' )
 194     {
 195         $community = $devdetails->param( 'snmp-community' );
 196         if( not defined( $community ) )
 197         {
 198             Error('Required parameter not defined: snmp-community');
 199             return 0;
 200         }
 201         $snmpargs{'-community'} = $community;
 202
 203         # set maxMsgSize to a maximum value for better compatibility
 204
 205         my $maxmsgsize = $devdetails->param('snmp-max-msg-size');
 206         if( defined( $maxmsgsize ) )
 207         {
 208             $devdetails->setParam('snmp-max-msg-size', $maxmsgsize);
 209             $snmpargs{'-maxmsgsize'} = $maxmsgsize;
 210         }
 211     }
 212     elsif( $version eq '3' )
 213     {
 214         foreach my $arg ( qw(-username -authkey -authpassword -authprotocol
 215                              -privkey -privpassword -privprotocol) )
 216         {
 217             if( defined $devdetails->param( 'snmp' . $arg ) )
 218             {
 219                 $snmpargs{$arg} = $devdetails->param( 'snmp' . $arg );
 220             }
 221         }
 222         $community = $snmpargs{'-username'};
 223         if( not defined( $community ) )
 224         {
 225             Error('Required parameter not defined: snmp-user');
 226             return 0;
 227         }
 228     }
 229     else
 230     {
 231         Error('Illegal value for snmp-version parameter: ' . $version);
 232         return 0;
 233     }
 234
 235     my $hostname = $devdetails->param('snmp-host');
 236     my $domain = $devdetails->param('domain-name');
 237
 238     if( $domain and index($hostname, '.') < 0 and index($hostname, ':') < 0 )
 239     {
 240          $hostname .= '.' . $domain;
 241     }
 242     $snmpargs{'-hostname'} = $hostname;
 243
 244     my $port = $snmpargs{'-port'};
 245     Debug('Discovering host: ' . $hostname . ':' . $port . ':' . $community);
 246
 247     my ($session, $error) =
 248         Net::SNMP->session( %snmpargs,
 249                             -nonblocking => 0,
 250                             -translate   => ['-all', 0, '-octetstring', 1] );
 251     if( not defined($session) )
 252     {
 253         Error('Cannot create SNMP session: ' . $error);
 254         return undef;
 255     }
 256
 257     my @oids = ();
 258     foreach my $var ( @systemOIDs )
 259     {
 260         push( @oids, $self->oiddef( $var ) );
 261     }
 262
 263     # This is the only checking if the remote agent is alive
 264
 265     my $result = $session->get_request( -varbindlist => \@oids );
 266     if( defined $result )
 267     {
 268         $devdetails->storeSnmpVars( $result );
 269     }
 270     else
 271     {
 272         # When the remote agent is reacheable, but system objecs are
 273         # not implemented, we get a positive error_status
 274         if( $session->error_status() == 0 )
 275         {
 276             Error("Unable to communicate with SNMP agent on " . $hostname .
 277                   ':' . $port . ':' . $community . " - " . $session->error());
 278             return undef;
 279         }
 280     }
 281
 282     my $data = $devdetails->data();
 283     $data->{'param'} = {};
 284
 285     $data->{'templates'} = [];
 286     my $customTmpl = $devdetails->param('custom-host-templates');
 287     if( length( $customTmpl ) > 0 )
 288     {
 289         push( @{$data->{'templates'}}, split( /\s*,\s*/, $customTmpl ) );
 290     }
 291
 292     # Build host-level legend
 293     my %legendValues =
 294         (
 295          10 => {
 296              'name'  => 'Location',
 297              'value' => $devdetails->snmpVar($self->oiddef('sysLocation'))
 298              },
 299          20 => {
 300              'name'  => 'Contact',
 301              'value' => $devdetails->snmpVar($self->oiddef('sysContact'))
 302              },
 303          30 => {
 304              'name'  => 'System ID',
 305              'value' => $devdetails->param('system-id')
 306              },
 307          50 => {
 308              'name'  => 'Description',
 309              'value' => $devdetails->snmpVar($self->oiddef('sysDescr'))
 310              }
 311          );
 312
 313     if( defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
 314     {
 315         $legendValues{40}{'name'} = 'Uptime';
 316         $legendValues{40}{'value'} =
 317             sprintf("%d days since %s",
 318                     $devdetails->snmpVar($self->oiddef('sysUpTime')) /
 319                     (100*3600*24),
 320                     strftime($Torrus::DevDiscover::timeFormat,
 321                              localtime(time())));
 322     }
 323
 324     my $legend = '';
 325     foreach my $key ( sort keys %legendValues )
 326     {
 327         my $text = $legendValues{$key}{'value'};
 328         if( length( $text ) > 0 )
 329         {
 330             $text = $devdetails->screenSpecialChars( $text );
 331             $legend .= $legendValues{$key}{'name'} . ':' . $text . ';';
 332         }
 333     }
 334
 335     if( $devdetails->param('suppress-legend') ne 'yes' )
 336     {
 337         $data->{'param'}{'legend'} = $legend;
 338     }
 339
 340     # some parameters need just one-to-one copying
 341
 342     my @hostCopyParams =
 343         split('\s*,\s*', $devdetails->param('host-copy-params'));
 344
 345     foreach my $param ( @copyParams, @hostCopyParams )
 346     {
 347         my $val = $devdetails->param( $param );
 348         if( length( $val ) > 0 )
 349         {
 350             $data->{'param'}{$param} = $val;
 351         }
 352     }
 353
 354     # If snmp-host is ipv6 address, system-id needs to be adapted to
 355     # remove colons
 356
 357     if( not defined( $data->{'param'}{'system-id'} ) and
 358         index($data->{'param'}{'snmp-host'}, ':') >= 0 )
 359     {
 360         my $systemid = $data->{'param'}{'snmp-host'};
 361         $systemid =~ s/:/_/g;
 362         $data->{'param'}{'system-id'} = $systemid;
 363     }
 364
 365     if( not defined( $devdetails->snmpVar($self->oiddef('sysUpTime')) ) )
 366     {
 367         Debug('Agent does not support sysUpTime');
 368         $data->{'param'}{'snmp-check-sysuptime'} = 'no';
 369     }
 370
 371     $data->{'param'}{'data-dir'} =
 372         $self->genDataDir( $devdetails->param('data-dir'), $hostname );
 373
 374     # Register the directory for listDataDirs()
 375     $self->{'datadirs'}{$devdetails->param('data-dir')} = 1;
 376
 377     $self->{'session'} = $session;
 378
 379     # some discovery modules need to be disabled on per-device basis
 380
 381     my %onlyDevtypes;
 382     my $useOnlyDevtypes = 0;
 383     foreach my $devtype ( split('\s*,\s*',
 384                                 $devdetails->param('only-devtypes') ) )
 385     {
 386         $onlyDevtypes{$devtype} = 1;
 387         $useOnlyDevtypes = 1;
 388     }
 389
 390     my %disabledDevtypes;
 391     foreach my $devtype ( split('\s*,\s*',
 392                                 $devdetails->param('disable-devtypes') ) )
 393     {
 394         $disabledDevtypes{$devtype} = 1;
 395     }
 396
 397     # 'checkdevtype' procedures for each known device type return true
 398     # when it's their device. They also research the device capabilities.
 399     my $reg = \%Torrus::DevDiscover::registry;
 400     foreach my $devtype
 401         ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
 402           keys %{$reg} )
 403     {
 404         if( ( not $useOnlyDevtypes or $onlyDevtypes{$devtype} ) and
 405             not $disabledDevtypes{$devtype} and
 406             &{$reg->{$devtype}{'checkdevtype'}}($self, $devdetails) )
 407         {
 408             $devdetails->setDevType( $devtype );
 409             Debug('Found device type: ' . $devtype);
 410         }
 411     }
 412
 413     my @devtypes = sort {
 414         $reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}
 415     } $devdetails->getDevTypes();
 416     $data->{'param'}{'devdiscover-devtypes'} = join(',', @devtypes);
 417
 418     $data->{'param'}{'devdiscover-nodetype'} = '::device';
 419
 420     # Do the detailed discovery and prepare data
 421     my $ok = 1;
 422     foreach my $devtype ( @devtypes )
 423     {
 424         $ok = &{$reg->{$devtype}{'discover'}}($self, $devdetails) ? $ok:0;
 425     }
 426
 427     delete $self->{'session'};
 428     $session->close();
 429
 430     $devdetails->applySelectors();
 431
 432     my $subtree = $devdetails->param('host-subtree');
 433     if( not defined( $self->{'devdetails'}{$subtree} ) )
 434     {
 435         $self->{'devdetails'}{$subtree} = [];
 436     }
 437     push( @{$self->{'devdetails'}{$subtree}}, $devdetails );
 438
 439     my $define_tokensets = $devdetails->param('define-tokensets');
 440     if( defined( $define_tokensets ) and length( $define_tokensets ) > 0 )
 441     {
 442         foreach my $pair ( split(/\s*;\s*/, $define_tokensets ) )
 443         {
 444             my( $tset, $description ) = split( /\s*:\s*/, $pair );
 445             if( $tset !~ /^[a-z][a-z0-9-_]*$/ )
 446             {
 447                 Error('Invalid name for tokenset: ' . $tset);
 448                 $ok = 0;
 449             }
 450             elsif( length( $description ) == 0 )
 451             {
 452                 Error('Missing description for tokenset: ' . $tset);
 453                 $ok = 0;
 454             }
 455             else
 456             {
 457                 $self->{'define-tokensets'}{$tset} = $description;
 458             }
 459         }
 460     }
 461     return $ok;
 462 }
 463
 464
 465 sub buildConfig
 466 {
 467     my $self = shift;
 468     my $cb = shift;
 469
 470     my $reg = \%Torrus::DevDiscover::registry;
 471
 472     foreach my $subtree ( sort keys %{$self->{'devdetails'}} )
 473     {
 474         # Chop the first and last slashes
 475         my $path = $subtree;
 476         $path =~ s/^\///;
 477         $path =~ s/\/$//;
 478
 479         # generate subtree path XML
 480         my $subtreeNode = undef;
 481         foreach my $subtreeName ( split( '/', $path ) )
 482         {
 483             $subtreeNode = $cb->addSubtree( $subtreeNode, $subtreeName );
 484         }
 485
 486         foreach my $devdetails
 487             ( sort {$a->param('snmp-host') cmp $b->param('snmp-host')}
 488               @{$self->{'devdetails'}{$subtree}} )
 489         {
 490
 491             my $data = $devdetails->data();
 492
 493             my @registryOverlays = ();
 494             if( defined( $devdetails->param('template-registry-overlays' ) ) )
 495             {
 496                 my @overlayNames =
 497                     split(/\s*,\s*/,
 498                           $devdetails->param('template-registry-overlays' ));
 499                 foreach my $overlayName ( @overlayNames )
 500                 {
 501                     if( defined( $templateOverlays{$overlayName}) )
 502                     {
 503                         push( @registryOverlays,
 504                               $templateOverlays{$overlayName} );
 505                     }
 506                     else
 507                     {
 508                         Error('Cannot find the template overlay named ' .
 509                               $overlayName);
 510                     }
 511                 }
 512             }
 513
 514             # we should call this anyway, in order to flush the overlays
 515             # set by previous host
 516             $cb->setRegistryOverlays( @registryOverlays );
 517
 518             if( $devdetails->param('disable-snmpcollector' ) eq 'yes' )
 519             {
 520                 push( @{$data->{'templates'}}, '::viewonly-defaults' );
 521             }
 522             else
 523             {
 524                 push( @{$data->{'templates'}}, '::snmp-defaults' );
 525             }
 526
 527             if( $devdetails->param('rrd-hwpredict' ) eq 'yes' )
 528             {
 529                 push( @{$data->{'templates'}}, '::holt-winters-defaults' );
 530             }
 531
 532
 533             my $devNodeName = $devdetails->param('symbolic-name');
 534             if( length( $devNodeName ) == 0 )
 535             {
 536                 $devNodeName = $devdetails->param('system-id');
 537                 if( length( $devNodeName ) == 0 )
 538                 {
 539                     $devNodeName = $devdetails->param('snmp-host');
 540                 }
 541             }
 542
 543             my $devNode = $cb->addSubtree( $subtreeNode, $devNodeName,
 544                                            $data->{'param'},
 545                                            $data->{'templates'} );
 546
 547             my $aliases = $devdetails->param('host-aliases');
 548             if( length( $aliases ) > 0 )
 549             {
 550                 foreach my $alias ( split( '\s*,\s*', $aliases ) )
 551                 {
 552                     $cb->addAlias( $devNode, $alias );
 553                 }
 554             }
 555
 556             my $includeFiles = $devdetails->param('include-files');
 557             if( length( $includeFiles ) > 0 )
 558             {
 559                 foreach my $file ( split( '\s*,\s*', $includeFiles ) )
 560                 {
 561                     $cb->addFileInclusion( $file );
 562                 }
 563             }
 564
 565
 566             # Let the device type-specific modules add children
 567             # to the subtree
 568             foreach my $devtype
 569                 ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
 570                   $devdetails->getDevTypes() )
 571             {
 572                 &{$reg->{$devtype}{'buildConfig'}}
 573                 ( $devdetails, $cb, $devNode, $self->{'globalData'} );
 574             }
 575
 576             $cb->{'statistics'}{'hosts'}++;
 577         }
 578     }
 579
 580     foreach my $devtype
 581         ( sort {$reg->{$a}{'sequence'} <=> $reg->{$b}{'sequence'}}
 582           keys %{$reg} )
 583     {
 584         if( defined( $reg->{$devtype}{'buildGlobalConfig'} ) )
 585         {
 586             &{$reg->{$devtype}{'buildGlobalConfig'}}($cb,
 587                                                      $self->{'globalData'});
 588         }
 589     }
 590
 591     if( defined( $self->{'define-tokensets'} ) )
 592     {
 593         my $tsetsNode = $cb->startTokensets();
 594         foreach my $tset ( sort keys %{$self->{'define-tokensets'}} )
 595         {
 596             $cb->addTokenset( $tsetsNode, $tset, {
 597                 'comment' => $self->{'define-tokensets'}{$tset} } );
 598         }
 599     }
 600 }
 601
 602
 603
 604 sub session
 605 {
 606     my $self = shift;
 607     return $self->{'session'};
 608 }
 609
 610 sub oiddef
 611 {
 612     my $self = shift;
 613     my $var = shift;
 614
 615     my $ret = $self->{'oiddef'}->{$var};
 616     if( not $ret )
 617     {
 618         Error('Undefined OID definition: ' . $var);
 619     }
 620     return $ret;
 621 }
 622
 623
 624 sub oidref
 625 {
 626     my $self = shift;
 627     my $oid = shift;
 628     return $self->{'oidref'}->{$oid};
 629 }
 630
 631
 632 sub genDataDir
 633 {
 634     my $self = shift;
 635     my $basedir = shift;
 636     my $hostname = shift;
 637
 638     if( $Torrus::DevDiscover::hashDataDirEnabled )
 639     {
 640         return $basedir . '/' .
 641             sprintf( $Torrus::DevDiscover::hashDataDirFormat,
 642                      unpack('N', md5($hostname)) %
 643                      $Torrus::DevDiscover::hashDataDirBucketSize );
 644     }
 645     else
 646     {
 647         return $basedir;
 648     }
 649 }
 650
 651
 652 sub listDataDirs
 653 {
 654     my $self = shift;
 655
 656     my @basedirs = keys %{$self->{'datadirs'}};
 657     my @ret = @basedirs;
 658
 659     if( $Torrus::DevDiscover::hashDataDirEnabled )
 660     {
 661         foreach my $basedir ( @basedirs )
 662         {
 663             for( my $i = 0;
 664                  $i < $Torrus::DevDiscover::hashDataDirBucketSize;
 665                  $i++ )
 666             {
 667                 push( @ret, $basedir . '/' .
 668                       sprintf( $Torrus::DevDiscover::hashDataDirFormat, $i ) );
 669             }
 670         }
 671     }
 672     return @ret;
 673 }
 674
 675 ##
 676 # Check if SNMP table is present, without retrieving the whole table
 677
 678 sub checkSnmpTable
 679 {
 680     my $self = shift;
 681     my $oidname = shift;
 682
 683     my $session = $self->session();
 684     my $oid = $self->oiddef( $oidname );
 685
 686     my $result = $session->get_next_request( -varbindlist => [ $oid ] );
 687     if( defined( $result ) )
 688     {
 689         # check if the returned oid shares the base of the query
 690         my $firstOid = (keys %{$result})[0];
 691         if( Net::SNMP::oid_base_match( $oid, $firstOid ) and
 692             length( $result->{$firstOid} ) > 0 )
 693         {
 694             return 1;
 695         }
 696     }
 697     return 0;
 698 }
 699
 700
 701 ##
 702 # Check if given OID is present
 703
 704 sub checkSnmpOID
 705 {
 706     my $self = shift;
 707     my $oidname = shift;
 708
 709     my $session = $self->session();
 710     my $oid = $self->oiddef( $oidname );
 711
 712     my $result = $session->get_request( -varbindlist => [ $oid ] );
 713     if( $session->error_status() == 0 and
 714         defined($result) and
 715         defined($result->{$oid}) and
 716         length($result->{$oid}) > 0 )
 717     {
 718         return 1;
 719     }
 720     return 0;
 721 }
 722
 723
 724 ##
 725 # retrieve the given OIDs by names and return hash with values
 726
 727 sub retrieveSnmpOIDs
 728 {
 729     my $self = shift;
 730     my @oidnames = @_;
 731
 732     my $session = $self->session();
 733     my $oids = [];
 734     foreach my $oidname ( @oidnames )
 735     {
 736         push( @{$oids}, $self->oiddef( $oidname ) );
 737     }
 738
 739     my $result = $session->get_request( -varbindlist => $oids );
 740     if( $session->error_status() == 0 and defined( $result ) )
 741     {
 742         my $ret = {};
 743         foreach my $oidname ( @oidnames )
 744         {
 745             $ret->{$oidname} = $result->{$self->oiddef( $oidname )};
 746         }
 747         return $ret;
 748     }
 749     return undef;
 750 }
 751
 752 ##
 753 # Simple wrapper for Net::SNMP::oid_base_match
 754
 755 sub oidBaseMatch
 756 {
 757     my $self = shift;
 758     my $base_oid = shift;
 759     my $oid = shift;
 760
 761     if( $base_oid =~ /^\D/ )
 762     {
 763         $base_oid = $self->oiddef( $base_oid );
 764     }
 765     return Net::SNMP::oid_base_match( $base_oid, $oid );
 766 }
 767
 768 ##
 769 # some discovery modules need to adjust max-msg-size
 770
 771 sub setMaxMsgSize
 772 {
 773     my $self = shift;
 774     my $devdetails = shift;
 775     my $msgsize = shift;
 776     my $opt = shift;
 777
 778     $opt = {} unless defined($opt);
 779
 780     if( (not $opt->{'only_v1_and_v2'}) or $self->session()->version() != 3 )
 781     {
 782         $self->session()->max_msg_size($msgsize);
 783         $devdetails->data()->{'param'}{'snmp-max-msg-size'} = $msgsize;
 784     }
 785 }
 786
 787
 788
 789
 790 ###########################################################################
 791 ####  Torrus::DevDiscover::DevDetails: the information container for a device
 792 ####
 793
 794 package Torrus::DevDiscover::DevDetails;
 795
 796 use strict;
 797 use Torrus::RPN;
 798 use Torrus::Log;
 799
 800 sub new
 801 {
 802     my $self = {};
 803     my $class = shift;
 804     bless $self, $class;
 805
 806     $self->{'params'}   = {};
 807     $self->{'snmpvars'} = {}; # SNMP results stored here
 808     $self->{'devtype'}  = {}; # Device types
 809     $self->{'caps'}     = {}; # Device capabilities
 810     $self->{'data'}     = {}; # Discovery data
 811
 812     return $self;
 813 }
 814
 815
 816 sub setParams
 817 {
 818     my $self = shift;
 819     my $params = shift;
 820
 821     while( my ($param, $value) = each %{$params} )
 822     {
 823         $self->{'params'}->{$param} = $value;
 824     }
 825 }
 826
 827
 828 sub setParam
 829 {
 830     my $self = shift;
 831     my $param = shift;
 832     my $value = shift;
 833
 834     $self->{'params'}->{$param} = $value;
 835 }
 836
 837
 838 sub param
 839 {
 840     my $self = shift;
 841     my $name = shift;
 842     return $self->{'params'}->{$name};
 843 }
 844
 845
 846 ##
 847 # store the query results for later use
 848
 849 sub storeSnmpVars
 850 {
 851     my $self = shift;
 852     my $vars = shift;
 853
 854     while( my( $oid, $value ) = each %{$vars} )
 855     {
 856         if( $oid !~ /^\d[0-9.]+\d$/o )
 857         {
 858             Error("Invalid OID syntax: '$oid'");
 859         }
 860         else
 861         {
 862             $self->{'snmpvars'}{$oid} = $value;
 863
 864             while( length( $oid ) > 0 )
 865             {
 866                 $oid =~ s/\d+$//o;
 867                 $oid =~ s/\.$//o;
 868                 if( not exists( $self->{'snmpvars'}{$oid} ) )
 869                 {
 870                     $self->{'snmpvars'}{$oid} = undef;
 871                 }
 872             }
 873         }
 874     }
 875
 876     # Clean the cache of sorted OIDs
 877     $self->{'sortedoids'} = undef;
 878 }
 879
 880 ##
 881 # check if the stored query results have such OID prefix
 882
 883 sub hasOID
 884 {
 885     my $self = shift;
 886     my $oid = shift;
 887
 888     my $found = 0;
 889     if( exists( $self->{'snmpvars'}{$oid} ) )
 890     {
 891         $found = 1;
 892     }
 893     return $found;
 894 }
 895
 896 ##
 897 # get the value of stored SNMP variable
 898
 899 sub snmpVar
 900 {
 901     my $self = shift;
 902     my $oid = shift;
 903     return $self->{'snmpvars'}{$oid};
 904 }
 905
 906 ##
 907 # get the list of table indices for the specified prefix
 908
 909 sub getSnmpIndices
 910 {
 911     my $self = shift;
 912     my $prefix = shift;
 913
 914     # Remember the sorted OIDs, as sorting is quite expensive for large
 915     # arrays.
 916
 917     if( not defined( $self->{'sortedoids'} ) )
 918     {
 919         $self->{'sortedoids'} = [];
 920         push( @{$self->{'sortedoids'}},
 921               Net::SNMP::oid_lex_sort( keys %{$self->{'snmpvars'}} ) );
 922     }
 923
 924     my @ret;
 925     my $prefixLen = length( $prefix ) + 1;
 926     my $matched = 0;
 927
 928     foreach my $oid ( @{$self->{'sortedoids'}} )
 929     {
 930         if( defined($self->{'snmpvars'}{$oid} ) )
 931         {
 932             if( Net::SNMP::oid_base_match( $prefix, $oid ) )
 933             {
 934                 # Extract the index from OID
 935                 my $index = substr( $oid, $prefixLen );
 936                 push( @ret, $index );
 937                 $matched = 1;
 938             }
 939             elsif( $matched )
 940             {
 941                 last;
 942             }
 943         }
 944     }
 945     return @ret;
 946 }
 947
 948
 949 ##
 950 # device type is the registered discovery module name
 951
 952 sub setDevType
 953 {
 954     my $self = shift;
 955     my $type = shift;
 956     $self->{'devtype'}{$type} = 1;
 957 }
 958
 959 sub isDevType
 960 {
 961     my $self = shift;
 962     my $type = shift;
 963     return $self->{'devtype'}{$type};
 964 }
 965
 966 sub getDevTypes
 967 {
 968     my $self = shift;
 969     return keys %{$self->{'devtype'}};
 970 }
 971
 972 ##
 973 # device capabilities. Each discovery module may define its own set of
 974 # capabilities and use them for information exchange between checkdevtype(),
 975 # discover(), and buildConfig() of its own and dependant modules
 976
 977 sub setCap
 978 {
 979     my $self = shift;
 980     my $cap = shift;
 981     Debug('Device capability: ' . $cap);
 982     $self->{'caps'}{$cap} = 1;
 983 }
 984
 985 sub hasCap
 986 {
 987     my $self = shift;
 988     my $cap = shift;
 989     return $self->{'caps'}{$cap};
 990 }
 991
 992 sub clearCap
 993 {
 994     my $self = shift;
 995     my $cap = shift;
 996     Debug('Clearing device capability: ' . $cap);
 997     if( exists( $self->{'caps'}{$cap} ) )
 998     {
 999         delete $self->{'caps'}{$cap};
1000     }
1001 }
1002
1003
1004
1005 sub data
1006 {
1007     my $self = shift;
1008     return $self->{'data'};
1009 }
1010
1011
1012 sub screenSpecialChars
1013 {
1014     my $self = shift;
1015     my $txt = shift;
1016
1017     $txt =~ s/:/{COLON}/gm;
1018     $txt =~ s/;/{SEMICOL}/gm;
1019     $txt =~ s/%/{PERCENT}/gm;
1020
1021     return $txt;
1022 }
1023
1024
1025 sub applySelectors
1026 {
1027     my $self = shift;
1028
1029     my $selList = $self->param('selectors');
1030     return if not defined( $selList );
1031
1032     my $reg = \%Torrus::DevDiscover::selectorsRegistry;
1033
1034     foreach my $sel ( split('\s*,\s*', $selList) )
1035     {
1036         my $type = $self->param( $sel . '-selector-type' );
1037         if( not defined( $type ) )
1038         {
1039             Error('Parameter ' . $sel . '-selector-type must be defined ' .
1040                   'for ' . $self->param('snmp-host'));
1041         }
1042         elsif( not exists( $reg->{$type} ) )
1043         {
1044             Error('Unknown selector type: ' . $type .
1045                   ' for ' . $self->param('snmp-host'));
1046         }
1047         else
1048         {
1049             Debug('Initializing selector: ' . $sel);
1050
1051             my $treg = $reg->{$type};
1052             my @objects = &{$treg->{'getObjects'}}( $self, $type );
1053
1054             foreach my $object ( @objects )
1055             {
1056                 Debug('Checking object: ' .
1057                       &{$treg->{'getObjectName'}}( $self, $object, $type ));
1058
1059                 my $expr = $self->param( $sel . '-selector-expr' );
1060                 $expr = '1' if length( $expr ) == 0;
1061
1062                 my $callback = sub
1063                 {
1064                     my $attr = shift;
1065                     my $checkval = $self->param( $sel . '-' . $attr );
1066
1067                     Debug('Checking attribute: ' . $attr .
1068                           ' and value: ' . $checkval);
1069                     my $ret = &{$treg->{'checkAttribute'}}( $self,
1070                                                             $object, $type,
1071                                                             $attr, $checkval );
1072                     Debug(sprintf('Returned value: %d', $ret));
1073                     return $ret;
1074                 };
1075
1076                 my $rpn = new Torrus::RPN;
1077                 my $result = $rpn->run( $expr, $callback );
1078                 Debug('Selector result: ' . $result);
1079                 if( $result )
1080                 {
1081                     my $actions = $self->param( $sel . '-selector-actions' );
1082                     foreach my $action ( split('\s*,\s*', $actions) )
1083                     {
1084                         my $arg =
1085                             $self->param( $sel . '-' . $action . '-arg' );
1086                         $arg = 1 if not defined( $arg );
1087
1088                         Debug('Applying action: ' . $action .
1089                               ' with argument: ' . $arg);
1090                         &{$treg->{'applyAction'}}( $self, $object, $type,
1091                                                    $action, $arg );
1092                     }
1093                 }
1094             }
1095         }
1096     }
1097 }
1098
1099 1;
1100
1101
1102 # Local Variables:
1103 # mode: perl
1104 # indent-tabs-mode: nil
1105 # perl-indent-level: 4
1106 # End: