1 # Copyright (C) 2002 Stanislav Sinyagin
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.
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.
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.
17 # $Id: Monitor.pm,v 1.1 2010-12-27 00:03:37 ivan Exp $
18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
20 package Torrus::Monitor;
21 @Torrus::Monitor::ISA = qw(Torrus::Scheduler::PeriodicTask);
26 use Torrus::ConfigTree;
27 use Torrus::Scheduler;
28 use Torrus::DataAccess;
29 use Torrus::TimeStamp;
38 if( not $options{'-Name'} )
40 $options{'-Name'} = "Monitor";
43 my $class = ref($proto) || $proto;
44 my $self = $class->SUPER::new( %options );
48 $self->{'tree_name'} = $options{'-TreeName'};
49 $self->{'sched_data'} = $options{'-SchedData'};
50 $self->{'delay'} = $options{'-Delay'} * 60;
59 my $config_tree = shift;
62 if( not defined( $self->{'targets'} ) )
64 $self->{'targets'} = [];
66 push( @{$self->{'targets'}}, $token );
77 new Torrus::ConfigTree( -TreeName => $self->{'tree_name'},
79 if( not defined( $config_tree ) )
84 my $da = new Torrus::DataAccess;
86 $self->{'db_alarms'} = new Torrus::DB('monitor_alarms',
87 -Subdir => $self->{'tree_name'},
90 foreach my $token ( @{$self->{'targets'}} )
92 &Torrus::DB::checkInterrupted();
94 my $mlist = $self->{'sched_data'}{'mlist'}{$token};
96 foreach my $mname ( @{$mlist} )
98 my $obj = { 'token' => $token, 'mname' => $mname };
102 my $mtype = $config_tree->getParam($mname, 'monitor-type');
103 $obj->{'mtype'} = $mtype;
105 my $method = 'check_' . $mtype;
106 my( $alarm, $timestamp ) = $self->$method( $config_tree, $obj );
107 $obj->{'alarm'} = $alarm;
108 $obj->{'timestamp'} = $timestamp;
110 Debug("Monitor $mname returned ($alarm, $timestamp) ".
113 $self->setAlarm( $config_tree, $obj );
118 $self->cleanupExpired();
120 undef $self->{'db_alarms'};
127 my $config_tree = shift;
130 my $token = $obj->{'token'};
131 my $file = $config_tree->getNodeParam( $token, 'data-file' );
132 my $dir = $config_tree->getNodeParam( $token, 'data-dir' );
133 my $ds = $config_tree->getNodeParam( $token, 'rrd-ds' );
135 my ($value, $timestamp) = $obj->{'da'}->read_RRD_DS( $dir.'/'.$file,
137 return( $value > 0 ? 1:0, $timestamp );
145 my $config_tree = shift;
148 my $token = $obj->{'token'};
149 my $mname = $obj->{'mname'};
151 my ($value, $timestamp) = $obj->{'da'}->read( $config_tree, $token );
152 $value = 'UNKN' unless defined($value);
154 my $expr = $value . ',' . $config_tree->getParam($mname,'rpn-expr');
155 $expr = $self->substitute_vars( $config_tree, $obj, $expr );
157 my $display_expr = $config_tree->getParam($mname,'display-rpn-expr');
158 if( defined( $display_expr ) )
161 $self->substitute_vars( $config_tree, $obj,
162 $value . ',' . $display_expr );
163 my ($dv, $dt) = $obj->{'da'}->read_RPN( $config_tree, $token,
164 $display_expr, $timestamp );
165 $obj->{'display_value'} = $dv;
169 $obj->{'display_value'} = $value;
172 return $obj->{'da'}->read_RPN( $config_tree, $token, $expr, $timestamp );
179 my $config_tree = shift;
183 my $token = $obj->{'token'};
184 my $mname = $obj->{'mname'};
186 if( index( $expr, '#' ) >= 0 )
189 if( exists( $self->{'varscache'}{$token} ) )
191 $vars = $self->{'varscache'}{$token};
196 $config_tree->getNodeParam( $token, 'monitor-vars' );
197 foreach my $pair ( split( '\s*;\s*', $varstring ) )
199 my( $var, $value ) = split( '\s*\=\s*', $pair );
200 $vars->{$var} = $value;
202 $self->{'varscache'}{$token} = $vars;
206 while( index( $expr, '#' ) >= 0 and $ok )
208 if( not $expr =~ /\#(\w+)/ )
210 Error("Error in monitor expression: $expr for monitor $mname");
216 my $val = $vars->{$var};
217 if( not defined $val )
219 Error("Unknown variable $var in monitor $mname");
224 $expr =~ s/\#$var/$val$1/g;
239 my $config_tree = shift;
242 my $token = $obj->{'token'};
243 my $mname = $obj->{'mname'};
244 my $alarm = $obj->{'alarm'};
245 my $timestamp = $obj->{'timestamp'};
247 my $key = $mname . ':' . $config_tree->path($token);
249 my $prev_values = $self->{'db_alarms'}->get( $key );
250 my ($t_set, $t_expires, $prev_status, $t_last_change);
251 if( defined($prev_values) )
253 Debug("Previous state found, Alarm: $alarm, ".
254 "Token: $token, Monitor: $mname");
255 ($t_set, $t_expires, $prev_status, $t_last_change) =
256 split(':', $prev_values);
261 $t_last_change = time();
265 if( not $prev_status )
279 $t_expires = $t_last_change +
280 $config_tree->getParam($mname, 'expires');
285 if( defined($t_expires) and time() > $t_expires )
287 $self->{'db_alarms'}->del( $key );
295 Debug("Event: $event, Monitor: $mname, Token: $token");
296 $obj->{'event'} = $event;
298 my $action_token = $token;
301 $config_tree->getNodeParam($token, 'monitor-action-target');
302 if( defined( $action_target ) )
304 Debug('Action target redirected to ' . $action_target);
305 $action_token = $config_tree->getRelative($token, $action_target);
306 Debug('Redirected to token ' . $action_token);
308 $obj->{'action_token'} = $action_token;
310 foreach my $aname (split(',',
311 $config_tree->getParam($mname, 'action')))
313 &Torrus::DB::checkInterrupted();
315 Debug("Running action: $aname");
316 my $method = 'run_event_' .
317 $config_tree->getParam($aname, 'action-type');
318 $self->$method( $config_tree, $aname, $obj );
321 if( $event ne 'forget' )
323 $self->{'db_alarms'}->put( $key,
333 # If an alarm is no longer in ConfigTree, it is not cleaned by setAlarm.
334 # We clean them up explicitly after they expire
340 &Torrus::DB::checkInterrupted();
342 my $cursor = $self->{'db_alarms'}->cursor(-Write => 1);
343 while( my ($key, $timers) = $self->{'db_alarms'}->next($cursor) )
345 my ($t_set, $t_expires, $prev_status, $t_last_change) =
348 if( $t_last_change and
349 time() > ( $t_last_change + $Torrus::Monitor::alarmTimeout ) and
350 ( (not $t_expires) or (time() > $t_expires) ) )
352 my ($mname, $path) = split(':', $key);
354 Info('Cleaned up an orphaned alarm: monitor=' . $mname .
356 $self->{'db_alarms'}->c_del( $cursor );
361 &Torrus::DB::checkInterrupted();
371 my $config_tree = shift;
375 my $token = $obj->{'action_token'};
376 my $event = $obj->{'event'};
378 if( $event eq 'set' or $event eq 'forget' )
380 my $tset = 'S'.$config_tree->getParam($aname, 'tset-name');
382 if( $event eq 'set' )
384 $config_tree->tsetAddMember($tset, $token, 'monitor');
388 $config_tree->tsetDelMember($tset, $token);
397 my $config_tree = shift;
401 my $token = $obj->{'action_token'};
402 my $event = $obj->{'event'};
403 my $mname = $obj->{'mname'};
404 my $timestamp = $obj->{'timestamp'};
406 my $launch_when = $config_tree->getParam($aname, 'launch-when');
407 if( not defined $launch_when )
409 $launch_when = 'set';
412 if( grep {$event eq $_} split(',', $launch_when) )
414 my $cmd = $config_tree->getParam($aname, 'command');
415 $cmd =~ s/\>\;/\>/;
416 $cmd =~ s/\<\;/\</;
418 $ENV{'TORRUS_BIN'} = $Torrus::Global::pkgbindir;
419 $ENV{'TORRUS_UPTIME'} = time() - $self->whenStarted();
421 $ENV{'TORRUS_TREE'} = $config_tree->treeName();
422 $ENV{'TORRUS_TOKEN'} = $token;
423 $ENV{'TORRUS_NODEPATH'} = $config_tree->path( $token );
426 $config_tree->getNodeParam( $token, 'descriptive-nickname' );
427 if( not defined( $nick ) )
429 $nick = $ENV{'TORRUS_NODEPATH'};
431 $ENV{'TORRUS_NICKNAME'} = $nick;
433 $ENV{'TORRUS_NCOMMENT'} =
434 $config_tree->getNodeParam( $token, 'comment', 1 );
435 $ENV{'TORRUS_NPCOMMENT'} =
436 $config_tree->getNodeParam( $config_tree->getParent( $token ),
438 $ENV{'TORRUS_EVENT'} = $event;
439 $ENV{'TORRUS_MONITOR'} = $mname;
440 $ENV{'TORRUS_MCOMMENT'} = $config_tree->getParam($mname, 'comment');
441 $ENV{'TORRUS_TSTAMP'} = $timestamp;
443 if( defined( $obj->{'display_value'} ) )
445 $ENV{'TORRUS_VALUE'} = $obj->{'display_value'};
447 my $format = $config_tree->getParam($mname, 'display-format');
448 if( not defined( $format ) )
453 $ENV{'TORRUS_DISPLAY_VALUE'} =
454 sprintf( $format, $obj->{'display_value'} );
457 my $severity = $config_tree->getParam($mname, 'severity');
458 if( defined( $severity ) )
460 $ENV{'TORRUS_SEVERITY'} = $severity;
464 $config_tree->getParam($aname, 'setenv-params');
466 if( defined( $setenv_params ) )
468 foreach my $param ( split( ',', $setenv_params ) )
470 # We retrieve the param from the monitored token, not
472 my $value = $config_tree->getNodeParam( $obj->{'token'},
474 if( not defined $value )
476 Warn('Parameter ' . $param . ' referenced in action '.
477 $aname . ', but not defined for ' .
478 $config_tree->path($obj->{'token'}));
482 my $envName = 'TORRUS_P_'.$param;
483 Debug("Setting environment $envName to $value");
484 $ENV{$envName} = $value;
488 my $setenv_dataexpr =
489 $config_tree->getParam($aname, 'setenv-dataexpr');
491 if( defined( $setenv_dataexpr ) )
493 # <param name="setenv_dataexpr" value="ENV1=expr1, ENV2=expr2"/>
494 # Integrity checks are done at compilation time.
495 foreach my $pair ( split( ',', $setenv_dataexpr ) )
497 my ($env, $param) = split( '=', $pair );
498 my $expr = $config_tree->getParam($aname, $param);
499 my ($value, $timestamp) =
500 $obj->{'da'}->read_RPN( $config_tree, $token, $expr );
501 my $envName = 'TORRUS_'.$env;
502 Debug("Setting environment $envName to $value");
503 $ENV{$envName} = $value;
507 Debug("Going to run command: $cmd");
508 my $status = system($cmd);
511 Error("$cmd executed with error: $!");
514 # Clean up the environment
515 foreach my $envName ( keys %ENV )
517 if( $envName =~ /^TORRUS_/ )
519 delete $ENV{$envName};
527 ####### Monitor scheduler ########
529 package Torrus::MonitorScheduler;
530 @Torrus::MonitorScheduler::ISA = qw(Torrus::Scheduler);
532 use Torrus::ConfigTree;
534 use Torrus::Scheduler;
535 use Torrus::TimeStamp;
541 my $tree = $self->treeName();
542 my $config_tree = new Torrus::ConfigTree(-TreeName => $tree, -Wait => 1);
543 if( not defined( $config_tree ) )
548 my $data = $self->data();
550 # Prepare the list of tokens, sorted by period and offset,
551 # from config tree or from cache.
553 my $need_new_tasks = 0;
555 Torrus::TimeStamp::init();
556 my $known_ts = Torrus::TimeStamp::get($tree . ':monitor_cache');
557 my $actual_ts = $config_tree->getTimestamp();
558 if( $actual_ts >= $known_ts )
560 if( $self->{'delay'} > 0 )
562 Info(sprintf('Delaying for %d seconds', $self->{'delay'}));
563 sleep( $self->{'delay'} );
566 Info("Rebuilding monitor cache");
567 Debug("Config TS: $actual_ts, Monitor TS: $known_ts");
569 undef $data->{'targets'};
572 $data->{'db_tokens'} = new Torrus::DB( 'monitor_tokens',
576 $self->cacheMonitors( $config_tree, $config_tree->token('/') );
577 # explicitly close, since we don't need it often, and sometimes
578 # open it in read-only mode
579 $data->{'db_tokens'}->closeNow();
580 undef $data->{'db_tokens'};
583 &Torrus::TimeStamp::setNow($tree . ':monitor_cache');
585 Torrus::TimeStamp::release();
587 &Torrus::DB::checkInterrupted();
589 if( not $need_new_tasks and not defined $data->{'targets'} )
593 $data->{'db_tokens'} = new Torrus::DB('monitor_tokens',
595 my $cursor = $data->{'db_tokens'}->cursor();
596 while( my ($token, $schedule) = $data->{'db_tokens'}->next($cursor) )
598 my ($period, $offset, $mlist) = split(':', $schedule);
599 if( not exists( $data->{'targets'}{$period}{$offset} ) )
601 $data->{'targets'}{$period}{$offset} = [];
603 push( @{$data->{'targets'}{$period}{$offset}}, $token );
604 $data->{'mlist'}{$token} = [];
605 push( @{$data->{'mlist'}{$token}}, split(',', $mlist) );
608 $data->{'db_tokens'}->closeNow();
609 undef $data->{'db_tokens'};
612 &Torrus::DB::checkInterrupted();
614 # Now fill in Scheduler's task list, if needed
616 if( $need_new_tasks )
618 Verbose("Initializing tasks");
619 my $init_start = time();
622 foreach my $period ( keys %{$data->{'targets'}} )
624 foreach my $offset ( keys %{$data->{'targets'}{$period}} )
626 my $monitor = new Torrus::Monitor( -Period => $period,
629 -SchedData => $data );
631 foreach my $token ( @{$data->{'targets'}{$period}{$offset}} )
633 &Torrus::DB::checkInterrupted();
635 $monitor->addTarget( $config_tree, $token );
638 $self->addTask( $monitor );
641 Verbose(sprintf("Tasks initialization finished in %d seconds",
642 time() - $init_start));
645 Verbose("Monitor initialized");
654 my $config_tree = shift;
657 my $data = $self->data();
659 foreach my $ctoken ( $config_tree->getChildren( $ptoken ) )
661 &Torrus::DB::checkInterrupted();
663 if( $config_tree->isSubtree( $ctoken ) )
665 $self->cacheMonitors( $config_tree, $ctoken );
667 elsif( $config_tree->isLeaf( $ctoken ) and
668 ( $config_tree->getNodeParam($ctoken, 'ds-type') ne
671 my $mlist = $config_tree->getNodeParam( $ctoken, 'monitor' );
674 my $period = sprintf('%d',
675 $config_tree->getNodeParam
676 ( $ctoken, 'monitor-period' ) );
677 my $offset = sprintf('%d',
678 $config_tree->getNodeParam
679 ( $ctoken, 'monitor-timeoffset' ) );
681 $data->{'db_tokens'}->put( $ctoken,
682 $period.':'.$offset.':'.$mlist );
684 push( @{$data->{'targets'}{$period}{$offset}}, $ctoken );
685 $data->{'mlist'}{$ctoken} = [];
686 push( @{$data->{'mlist'}{$ctoken}}, split(',', $mlist) );
698 # indent-tabs-mode: nil
699 # perl-indent-level: 4