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