src/lib/Torrus/DevDiscover/DevDetails.pm

   1 #  Copyright (C) 2002-2011  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 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  18
  19
  20 ####  Torrus::DevDiscover::DevDetails: the information container for a device
  21 ####
  22
  23 package Torrus::DevDiscover::DevDetails;
  24 use strict;
  25 use warnings;
  26
  27 use Torrus::RPN;
  28 use Torrus::Log;
  29
  30 our $VERSION = 1.0;
  31
  32 sub new
  33 {
  34     my $self = {};
  35     my $class = shift;
  36     bless $self, $class;
  37
  38     $self->{'params'}   = {};
  39     $self->{'snmpvars'} = {}; # SNMP results stored here
  40     $self->{'devtype'}  = {}; # Device types
  41     $self->{'caps'}     = {}; # Device capabilities
  42     $self->{'data'}     = {}; # Discovery data
  43
  44     return $self;
  45 }
  46
  47
  48 sub setParams
  49 {
  50     my $self = shift;
  51     my $params = shift;
  52
  53     while( my ($param, $value) = each %{$params} )
  54     {
  55         $self->{'params'}->{$param} = $value;
  56     }
  57     return;
  58 }
  59
  60
  61 sub setParam
  62 {
  63     my $self = shift;
  64     my $param = shift;
  65     my $value = shift;
  66
  67     $self->{'params'}->{$param} = $value;
  68     return;
  69 }
  70
  71
  72 sub param
  73 {
  74     my $self = shift;
  75     my $name = shift;
  76     return $self->{'params'}->{$name};
  77 }
  78
  79
  80 # The following 3 methods get around undefined parameters and
  81 # make "use warnings" happy
  82
  83 sub paramEnabled
  84 {
  85     my $self = shift;
  86     my $name = shift;
  87     my $val = $self->param($name);
  88     return (defined($val) and ($val eq 'yes'));
  89 }
  90
  91 sub paramDisabled
  92 {
  93     my $self = shift;
  94     my $name = shift;
  95     my $val = $self->param($name);
  96     return (not defined($val) or ($val ne 'yes'));
  97 }
  98
  99 sub paramString
 100 {
 101     my $self = shift;
 102     my $name = shift;
 103     my $val = $self->param($name);
 104     return (defined($val) ? $val:'');
 105 }
 106
 107
 108 ##
 109 # store the query results for later use
 110 # WARNING: this method is deprecated. Use $dd->walkSnmpTable() instead.
 111
 112 sub storeSnmpVars
 113 {
 114     my $self = shift;
 115     my $vars = shift;
 116
 117     while( my( $oid, $value ) = each %{$vars} )
 118     {
 119         if( $oid !~ /^\d[0-9.]+\d$/o )
 120         {
 121             Error('Invalid OID syntax: from ' .
 122                   $self->paramString('snmp-host') .
 123                   ': \'' . $oid . '\'');
 124         }
 125         else
 126         {
 127             $self->{'snmpvars'}{$oid} = $value;
 128
 129             while( $oid ne '' )
 130             {
 131                 $oid =~ s/\d+$//o;
 132                 $oid =~ s/\.$//o;
 133                 if( not exists( $self->{'snmpvars'}{$oid} ) )
 134                 {
 135                     $self->{'snmpvars'}{$oid} = undef;
 136                 }
 137             }
 138         }
 139     }
 140
 141     # Clean the cache of sorted OIDs
 142     $self->{'sortedoids'} = undef;
 143     return;
 144 }
 145
 146 ##
 147 # check if the stored query results have such OID prefi
 148 # WARNING: this method is deprecated. Use $dd->checkSnmpTable() instead.
 149
 150 sub hasOID
 151 {
 152     my $self = shift;
 153     my $oid = shift;
 154
 155     my $found = 0;
 156     if( exists( $self->{'snmpvars'}{$oid} ) )
 157     {
 158         $found = 1;
 159     }
 160     return $found;
 161 }
 162
 163 ##
 164 # get the value of stored SNMP variable
 165 # WARNING: this method is deprecated.
 166
 167 sub snmpVar
 168 {
 169     my $self = shift;
 170     my $oid = shift;
 171     return $self->{'snmpvars'}{$oid};
 172 }
 173
 174 ##
 175 # get the list of table indices for the specified prefix
 176 # WARNING: this method is deprecated. Use $dd->walkSnmpTable() instead.
 177
 178 sub getSnmpIndices
 179 {
 180     my $self = shift;
 181     my $prefix = shift;
 182
 183     # Remember the sorted OIDs, as sorting is quite expensive for large
 184     # arrays.
 185
 186     if( not defined( $self->{'sortedoids'} ) )
 187     {
 188         $self->{'sortedoids'} = [];
 189         push( @{$self->{'sortedoids'}},
 190               Net::SNMP::oid_lex_sort( keys %{$self->{'snmpvars'}} ) );
 191     }
 192
 193     my @ret;
 194     my $prefixLen = length( $prefix ) + 1;
 195     my $matched = 0;
 196
 197     for my $oid ( @{$self->{'sortedoids'}} )
 198     {
 199         if( defined($self->{'snmpvars'}{$oid} ) )
 200         {
 201             if( Net::SNMP::oid_base_match( $prefix, $oid ) )
 202             {
 203                 # Extract the index from OID
 204                 my $index = substr( $oid, $prefixLen );
 205                 push( @ret, $index );
 206                 $matched = 1;
 207             }
 208             elsif( $matched )
 209             {
 210                 last;
 211             }
 212         }
 213     }
 214     return @ret;
 215 }
 216
 217
 218 ##
 219 # device type is the registered discovery module name
 220
 221 sub setDevType
 222 {
 223     my $self = shift;
 224     my $type = shift;
 225     $self->{'devtype'}{$type} = 1;
 226     return;
 227 }
 228
 229 sub isDevType
 230 {
 231     my $self = shift;
 232     my $type = shift;
 233     return $self->{'devtype'}{$type};
 234 }
 235
 236 sub getDevTypes
 237 {
 238     my $self = shift;
 239     return keys %{$self->{'devtype'}};
 240 }
 241
 242 ##
 243 # device capabilities. Each discovery module may define its own set of
 244 # capabilities and use them for information exchange between checkdevtype(),
 245 # discover(), and buildConfig() of its own and dependant modules
 246
 247 sub setCap
 248 {
 249     my $self = shift;
 250     my $cap = shift;
 251     Debug('Device capability: ' . $cap);
 252     $self->{'caps'}{$cap} = 1;
 253     return;
 254 }
 255
 256 sub hasCap
 257 {
 258     my $self = shift;
 259     my $cap = shift;
 260     return $self->{'caps'}{$cap};
 261 }
 262
 263 sub clearCap
 264 {
 265     my $self = shift;
 266     my $cap = shift;
 267     Debug('Clearing device capability: ' . $cap);
 268     if( exists( $self->{'caps'}{$cap} ) )
 269     {
 270         delete $self->{'caps'}{$cap};
 271     }
 272     return;
 273 }
 274
 275
 276
 277 sub data
 278 {
 279     my $self = shift;
 280     return $self->{'data'};
 281 }
 282
 283
 284 sub screenSpecialChars
 285 {
 286     my $self = shift;
 287     my $txt = shift;
 288
 289     $txt =~ s/:/{COLON}/gm;
 290     $txt =~ s/;/{SEMICOL}/gm;
 291     $txt =~ s/%/{PERCENT}/gm;
 292
 293     return $txt;
 294 }
 295
 296
 297 sub applySelectors
 298 {
 299     my $self = shift;
 300
 301     my $selList = $self->param('selectors');
 302     return if not defined( $selList );
 303
 304     my $reg = \%Torrus::DevDiscover::selectorsRegistry;
 305
 306     for my $sel ( split('\s*,\s*', $selList) )
 307     {
 308         my $type = $self->param( $sel . '-selector-type' );
 309         if( not defined( $type ) )
 310         {
 311             Error('Parameter ' . $sel . '-selector-type must be defined ' .
 312                   'for ' . $self->param('snmp-host'));
 313         }
 314         elsif( not exists( $reg->{$type} ) )
 315         {
 316             Error('Unknown selector type: ' . $type .
 317                   ' for ' . $self->param('snmp-host'));
 318         }
 319         else
 320         {
 321             Debug('Initializing selector: ' . $sel);
 322
 323             my $treg = $reg->{$type};
 324             my @objects = &{$treg->{'getObjects'}}( $self, $type );
 325
 326             for my $object ( @objects )
 327             {
 328                 Debug('Checking object: ' .
 329                       &{$treg->{'getObjectName'}}( $self, $object, $type ));
 330
 331                 my $expr = $self->param( $sel . '-selector-expr' );
 332                 $expr = '1' if ($expr eq '');
 333
 334                 my $callback = sub
 335                 {
 336                     my $attr = shift;
 337                     my $checkval = $self->param( $sel . '-' . $attr );
 338
 339                     Debug('Checking attribute: ' . $attr .
 340                           ' and value: ' . $checkval);
 341                     my $ret = &{$treg->{'checkAttribute'}}( $self,
 342                                                             $object, $type,
 343                                                             $attr, $checkval );
 344                     Debug(sprintf('Returned value: %d', $ret));
 345                     return $ret;
 346                 };
 347
 348                 my $rpn = Torrus::RPN->new();
 349                 my $result = $rpn->run( $expr, $callback );
 350                 Debug('Selector result: ' . $result);
 351                 if( $result )
 352                 {
 353                     my $actions = $self->param( $sel . '-selector-actions' );
 354                     for my $action ( split('\s*,\s*', $actions) )
 355                     {
 356                         my $arg =
 357                             $self->param( $sel . '-' . $action . '-arg' );
 358                         $arg = 1 if not defined( $arg );
 359
 360                         Debug('Applying action: ' . $action .
 361                               ' with argument: ' . $arg);
 362                         &{$treg->{'applyAction'}}( $self, $object, $type,
 363                                                    $action, $arg );
 364                     }
 365                 }
 366             }
 367         }
 368     }
 369
 370     return;
 371 }
 372
 373 1;
 374
 375
 376 # Local Variables:
 377 # mode: perl
 378 # indent-tabs-mode: nil
 379 # perl-indent-level: 4
 380 # End: