# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-03 08:56 (EST)
# Function: the service class
#
# $Id: Service.pm,v 1.95 2005/11/25 17:11:41 jaw Exp $

package Service;
@ISA = qw(MonEl BaseIO);
use Argus::Encode;

# to put fresh wood on the fire, chop fuel, carve, cook, pour out wine,
# and do all those services that poor men have to do for their betters.
#   -- Homer, Odyssey

use TCP;
use UDP;
use Prog;
use Ping;
use Self;
use DataBase;
BEGIN {
    # these may or may not be present
    eval { require Argus::Asterisk; };		# asterisk manager interface
    eval { require Argus::Agent; };		# remote system monitoring agent
}

use strict qw(refs vars);
use vars qw(@ISA $doc $n_services $n_tested @probes);

my $ZERO_FREQ    = 60;
my $PHASE_QUANTA = 6;
$n_services   = 0;	# initialized in Conf.pm readconfig()
$n_tested     = 0;
@probes;	# this is not a useless use of a variable. it is documentation.


$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [@ISA],
    conf => {
	quotp => 0,
	bodyp => 0,
    },
    methods => {
	start   => {},
	done    => {},
	timeout => {},
	isdown  => {},
	isup    => {},
	update  => {},
    },
    html  => 'services',
    fields => {
      srvc::frequency => {
	  descr => 'how often the test should occur - in seconds',
	  attrs => ['config', 'inherit'],
	  default => 60,
      },
      srvc::phi     => {
	  descr => 'phase - a scheduling parameter',
      },
      srvc::retries => {
	  descr => 'number of times to retry a service before declaring it down',
	  attrs => ['config', 'inherit'],
	  default => 2,
      },
      srvc::retrydelay => {
	  # NB: can be 0 to retry immediately
	  #     default (undef) - wait until next scheduled test
	  descr => 'how soon to retry after a failure, instead of waiting until the next scheduled test',
	  attrs => ['config', 'inherit'],
      },
      srvc::timeout => {
	  descr => 'how long to wait for a response before giving up',
	  attrs => ['config', 'inherit'],
	  default => 60,
      },
      srvc::status  => { descr => 'raw status from most recent test' },
      srvc::lasttesttime => {
	  descr => 'time of last test',
      },
      srvc::nexttesttime => {
	  descr => 'time of next test'
      },
      srvc::state => {
	  descr => 'state of the test underway',
      },
      srvc::tries => {
	  descr => 'number of times tried',
      },
      srvc::reason => {
	  descr => 'reason the test failed',
      },
      srvc::result => {
	  # calculated by g_test, used as input to graphing
	  descr => 'any result data returned by the test',
      },
      srvc::dead => {
	  descr => 'is this service dead',	# for debugging
      },
      srvc::elapsed => {
	  # with very coarse resolution, unless Time::HiRes is installed
	  descr => 'how long did the test take', 
      },
      srvc::showreason => {
	  descr => 'display the reason the service is down on the web page',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'no',
	  versn => '3.2',
      },
      srvc::finished => {
	  descr => 'for detecting buggy code',
      },

      srvc::disabled => {
	  descr => 'the test is temporarily disabled and not being run',
	  versn => '3.3',
	  # if set, should specify some indication of who or why it is disabled
	  # used by DARP, also perhaps useful to toggle via argusctl
      },

      srvc::invert_status => {
	  attrs => ['config', 'bool'],
	  versn => '3.3',
      },
	
      # generic test calculations
      test::snmpcalc => {
	  descr => 'deprecated, use calc instead',
	  attrs => ['config'],
	  versn => '3.2',
      },
      test::calc => {
	  descr => 'manipulate value in some manner',
	  attrs => ['config'],
	  # ave, rate, jitter, bits, delta, inet, one
	  # one - only interesting for debugging
	  exmpl => 'rate, ave, bits',
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::perlexpr => {
	  descr => 'manipulate value in some manner',
	  attrs => ['config'],
	  exmpl => 'log($value) * 4',
	  versn => '3.3',
	  html  => 'xtservices',
      },
      test::alpha => {
	  descr => 'time constant for decaying average calculation',
	  # ave = (alpha * ave + value) / (alpha + 1)
	  # if you don't understand, leave it alone
	  attrs => ['config', 'inherit'],
	  default => '1',
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::pluck => {
	  # we process the value with the regex, and replace with $1
	  descr => 'use this regex to pluck a value to test out of the result. should contain ()s',
	  attrs => ['config'],
	  exmpl => '\s+(\d+)%',
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::unpack => {
	  # in standard perl unpack syntax $value = unpack($unpack, $value)
	  descr => 'template for unpacking a binary data structure',
	  attrs => ['config'],
	  exmpl => 'x8 N',
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::scale => {
	  # $value /= $scale
	  descr => 'scale factor',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::spike_supress => {
	  descr => 'supress transient spikes',
	  attrs => ['config', 'inherit'],
	  default => 1,
	  versn => '3.4',
      },
      test::rawvalue => {
	  descr => 'initial raw value for test',
      },
      test::calcdata => {
	  descr => 'assorted data',
      },
      test::currvalue => {
	  descr => 'most recent value returned by query (rawvalue after processing)',
      },
      test::testedp => {
	  descr => 'is there a test configured?',
      },
	
      # generic test value fields
      test::expect => {
	  descr => 'test value - fail test if value does not match regex',
	  attrs => ['config'],
      },
      test::nexpect => {
	  # I'm not sure that this is useful, but it provides symmetry
	  descr => 'test value - fail test if value does match regex',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::minvalue => {
	  descr => 'test value - fail test if value falls below this',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::maxvalue => {
	  descr => 'test value - fail test if value rises above this',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::eqvalue => {
	  descr => 'test value - fail test if value does not equal this',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },
      test::nevalue => {
	  descr => 'test value - fail test if value equals this',
	  attrs => ['config'],
	  versn => '3.2',
	  html  => 'xtservices',
      },

      srvc::starts => {},
      srvc::dones  => {},
	
    },
};

sub new {
    my $class = shift || 'Service';
    my $x = {};
    bless $x, $class;
    $x;
}

sub config {
    my $me = shift;
    my $cf = shift;
    my $more = shift;
    my( $k, $kk, $v, $p, $best, $pa );

    # What services canst thou do?
    #   -- Shakespesare, King Lear
    # probe, find best match
    foreach $p (@probes){
	my $c = $p->( $me->{name} );
	if( $c ){
	    # probe returns undef or [match, \&config]
	    $best = $c if( !$best || $c->[0] > $best->[0] );
	}
    }

    # service specification errors should only abort this service, trap any errors
    eval {
	# config from best matching probe
	if( $best ){
	    $best->[1]->($me, $cf, $more);
	}else{
	    $cf->error( "unknown service '$me->{name}'" );
	}
    };
    if( $@ ){
	print STDERR "$@\n" if $::opt_f && !ref($@);
	return undef;
    }


    $me->init_from_config( $doc, 'srvc' );
    $me->generic_test_config($cf);

    # frequency = 0 is not permitted
    $me->{srvc}{frequency} ||= $ZERO_FREQ;
    
    # if we have lots of services, spread them around a bit more...
    $pa = (($n_services / 200) % 2) ? 0 : int($PHASE_QUANTA/2);
    $pa = 0 if $me->{srvc}{frequency} < $PHASE_QUANTA;
    $me->{srvc}{phi} = int(rand(int($me->{srvc}{frequency}/$PHASE_QUANTA))) * $PHASE_QUANTA
	+ $pa;
        
    $me->{uname} = "$me->{name}" unless $me->{uname};
    return undef unless $me->init($cf);

    # the default is different for Service, set if not specified in config
    $me->{notify}{sendnotify} = 1 unless defined $me->{notify}{sendnotify};
    unless( $me->{notify}{sendnotify2} ){
	$me->{notify}{sendnotify} = 0;
    }

    $cf->warning( "test frequency is less than retrydelay" )
	if $me->{srvc}{retrydelay} && $me->{srvc}{frequency} < $me->{srvc}{retrydelay};

    if( $me->{srvc}{invert_status} ){
	$me->{flags} .= ' status-inverted';
    }
    
    $me->configured();
    
    $n_services ++;
    $me->reschedule();
    $me;
}

sub configured {}

sub reschedule {
    my $me = shift;
    my( $f, $p, $when );

    # My fellow-scholars, and to keep those statutes
    # That are recorded in this schedule here:
    #   -- Shakespeare, Loves Labors Lost
    if( $me->{srvc}{tries} && defined($me->{srvc}{retrydelay}) ){
	$when = $^T + $me->{srvc}{retrydelay};
    }else{
	$f = $me->{srvc}{frequency};
	$p = $me->{srvc}{phi};
    	$when = int( ($^T - $p) / $f ) * $f + $f + $p;
    }
    if( $me->{srvc}{nexttesttime} < $when ){
	$me->{srvc}{nexttesttime} = $when;
	$me->add_timed_func( time => $when,
			     text => 'service start',
			     func => \&me_start,
			     );
    }
}

sub me_start {
    my $me = shift;

    $me->pre_start_check();
}

sub pre_start_check {
    my $me = shift;
    
    return $me->reschedule() if $me->{srvc}{disabled};
    $me->start();
}

sub about_more {
    my $me = shift;
    my $ctl = shift;
    my( $b, $k, $v );

    $me->more_about_whom($ctl, 'srvc', 'test', 'test::calcdata');
}

sub start {
    my $me = shift;

    # if( $me->{srvc}{dead} ){
    # 	  trace();
    # }

    undef $me->{srvc}{finished};
    $me->{srvc}{state} = 'starting';
    $me->{srvc}{lasttesttime} = BaseIO::ctime();
    $me->{srvc}{tries} = 1 unless $me->{srvc}{tries};
    $me->debug( 'Service start' );
    $n_tested ++;
    $me->{srvc}{starts} ++;
}

sub done {
    my $me = shift;

    $me->shutdown();
    $me->{srvc}{state} = 'done';
    $me->debug( 'Service done' );
    $me->{srvc}{dones} ++;
    
    if( $me->{srvc}{finished} ){
	my $c = ref $me;
	::sysproblem( "BUG in module $c - " . $me->unique() . " finished twice" );
    }else{
	$me->{srvc}{finished} = 1;
	$me->reschedule() unless $me->{srvc}{dead};
    }
}

sub recycle {
    my $me = shift;

    $n_services --;
    $me->{srvc}{dead} = 1;
    $me->MonEl::recycle();
    $me->BaseIO::recycle();
}

sub isdown_f {	# force it
    my $me = shift;
    
    $me->{srvc}{tries} = $me->{srvc}{retries} + 1;
    $me->isdown( @_ );
}

sub isdown {
    my $me = shift;
    my $reason = shift;
    my $altval = shift;
    my $sever  = shift;		# QQQ - useful?
    
    $me->{srvc}{elapsed} = 0;
    $me->{srvc}{reason}  = $reason;
    $me->{srvc}{status} = 'down';
    # to make %v in notifications more useful
    $me->{srvc}{result}  = $altval if defined $altval && exists $me->{srvc}{result};
    
    $me->debug( "Service DOWN - $reason" ) if $reason;
    
    if( ($me->{srvc}{tries} || 0) <= $me->{srvc}{retries} ){
	# Sometimes to do me service: nine or ten times
	#   -- Shakespeare, Othello
	$me->debug( 'Service - retrying' );
	$me->{srvc}{tries} ++;
    }else{
	# For some displeasing service I have done
	#   -- Shakespeare, King Henry IV
	$me->debug( 'Service DOWN' );
	$me->{srvc}{tries} = 0;
	$me->update( $me->{srvc}{invert_status} ? 'up' : 'down', $sever );
    }

    $me->graph_add_sample( $me->{srvc}{result}, $me->{ovstatus} )
	if $me->{graph};
    $me->done();
}

sub isup {
    my $me = shift;

    $me->debug( 'Service - UP' );
    $me->{srvc}{elapsed} = $::TIME - $me->{srvc}{lasttesttime};
    $me->{srvc}{reason} = undef;
    $me->{srvc}{tries} = 0;
    $me->{srvc}{status} = 'up';
    $me->update( $me->{srvc}{invert_status} ? 'down' : 'up' );
    
    $me->graph_add_sample( $me->{srvc}{result}, $me->{ovstatus} )
	if $me->{graph};
    $me->done();
}

sub update {
    my $me = shift;
    my $st = shift;
    my $sv = shift;

    $me->{srvc}{status} = $st;
    
    if( $st ne $me->{status} ){
	$me->transition( $st, $sv );
    }
}

# override MonEl::transition and jiggle
sub transition {
    my $me = shift;
    my $st = shift;
    my $sv = shift;
    
    if( $st eq 'down' && $me->{watch} && $me->{watch}{watching} ){
	$me->tkt_watch_down();
	return;
    }

    if( $st ){
	my $ps = $me->{status};
	my $po = $me->{ovstatus};
	$me->{status}    = $st;
	$me->{ovstatus}  = $st;
	$me->{transtime} = $^T;
	# these may get cleared in t2 if there is an override
	$me->{alarm}        = (($me->{status} eq 'down') && $me->{siren}) ? 1 : 0;
	$me->{currseverity} = ($me->{status} eq 'down') ? ($sv || $me->{severity}) : 'clear';
	
	$me->transition2();
	$me->{prevstatus}   = $ps;
	$me->{prevovstatus} = $po;
	$me->loggit( msg => $me->{ovstatus},
		     tag => 'TRANSITION',
		     slp => 1 ) if $me->{prevovstatus} ne $me->{ovstatus};
    }else{
	$me->{prevovstatus} = $me->{ovstatus};
	$me->{ovstatus}     = $me->{status};
	$me->{currseverity} = ($me->{status} eq 'down') ? ($sv || $me->{severity}) : 'clear';
	$me->transition2();
    }

    $me->transition_propagate();
}

sub jiggle {
    my $me = shift;

    $me->{currseverity} ||= ($me->{status} eq 'down') ? $me->{severity} : 'clear';
    
    $me->transition_propagate();
}

sub webpage {
    my $me = shift;
    my $fh = shift;
    my $topp = shift;  # NOT USED
    my( $k, $v, $vv, $x, $kk );

    print $fh "<!-- start of Service::webpage -->\n";
    
    # object data
    print $fh "<TABLE CLASS=SRVCDTA>\n";
    foreach $k (qw(name ovstatus flags info note comment annotation details)){
	$v = $vv = $me->{$k};
	$kk = $k;
	$x = '';
	if( $k eq 'ovstatus' ){
	    $x = ' BGCOLOR="' . MonEl::web_color($v, $me->{currseverity}) . '"';
	    $kk = 'status';
	}
	if( $k eq 'ovstatus' || $k eq 'flags' ){
	    $vv = "<L10N $v>";
	}
	print $fh "<TR><TD><L10N $kk></TD><TD$x>$vv</TD></TR>\n" if defined($v);
	if( $k eq 'ovstatus' && $v eq 'down' && $me->{srvc}{showreason} && $me->{srvc}{reason} ){
	    print $fh "<TR><TD>...<L10N because></TD><TD>$me->{srvc}{reason}</TD></TR>\n";
	}
	if( $k eq 'ovstatus' && $me->{depend}{culprit} ){
	    # QQQ - is this really how I want to do it?
	    my $o = $MonEl::byname{$me->{depend}{culprit}};
	    print $fh "<TR><TD>...<L10N because></TD><TD>";
	    print $fh "<A HREF=\"" . $o->url('func=page') . "\">" if $o;
	    print $fh $me->{depend}{culprit};
	    print $fh "</A>" if $o;
	    print $fh " <L10N is down></TD></TR>\n";
	}
    }
    
    $me->webpage_more($fh) if $me->can('webpage_more');
    print $fh "</TABLE>\n";

    $me->web_override($fh);
    
    print $fh "<!-- end of Service::webpage -->\n";
}

sub web_page_row_base {
    my $me = shift;
    my $fh = shift;
    my $label = shift;
    
    return if $me->{web}{hidden};
    print $fh '<TR><TD><A HREF="', $me->url('func=page'), '">',
        ($label||$me->{label_left}||$me->{name}), '</A></TD>';

    my $st = $me->{ovstatus};
    my $cl = MonEl::web_color($st, $me->{currseverity});
    if( $st eq 'up' ){
	print $fh "<TD BGCOLOR=\"$cl\">$st</TD><TD></TD><TD></TD>";
    }elsif( $st eq 'override' ){
	print $fh "<TD></TD><TD></TD><TD BGCOLOR=\"$cl\">$st</TD>";
    }else{
	print $fh "<TD></TD><TD BGCOLOR=\"$cl\">$st</TD><TD></TD>";
    }
    print $fh "</TR>\n";
}

sub web_page_row_top {
    my $me = shift;
    $me->web_page_row_base(@_);
}

sub generic_test_config {
    my $me = shift;
    my $cf = shift;
    
    $me->init_from_config( $doc, 'test' );

    # RSN - remove at some point (prior to 3.3)
    if( !$me->{test}{calc} && $me->{test}{snmpcalc} ){
	$cf->warning( 'snmpcalc is deprecated. use calc instead' ) if $cf;
	$me->{test}{calc} = $me->{test}{snmpcalc};
    }
    
    foreach my $p (qw/expect nexpect minvalue maxvalue
		   eqvalue nevalue calc pluck unpack scale perlexpr/){
	$me->{test}{testedp} = 1 if defined($me->{test}{$p});
    }

}

sub generic_test {
    my $me    = shift;
    my $value = shift;
    my $tag   = shift;
    my( $foo, $transient );

    $me->{test}{rawvalue} = $value;

    eval {
	no strict;
	# no warnings;  # XXX - not available in 5.00503
	
	# 1st pre-process the value into shape
	if( $me->{test}{pluck} ){
	    # pluck a value ($1) from the result with a regex
	    my $p = $me->{test}{pluck};
	    $value =~ /$p/s;
	    $value = $1;
	}
	
	if( $me->{test}{unpack} ){
	    # do we need to unpack a binary value?
	    $value = unpack( $me->{test}{unpack}, $value );
	}
	
	if( $me->{test}{scale} ){
	    # scale value (most useful for fixing NTP fixed point values)
	    $value /= $me->{test}{scale};
	}

	$me->debug( "$tag TEST value $value" );
	
	# then calculate derived values
	if( $me->{test}{calc} ){
	    
	    if( $me->{test}{calc} =~ /one/ ){
		$value = 1;
	    }
	    if( $me->{test}{calc} =~ /elapsed/ ){
		# srcv::elapsed is calculated after testing...
		$value = $::TIME - $me->{srvc}{lasttesttime};
	    }
	    
	    if( $me->{test}{calc} =~ /rate|delta/ ){
		my( $dv, $dt );
		$value += 0;
		if( defined($me->{test}{calcdata}{lastv}) ){
		    if( $value < $me->{test}{calcdata}{lastv} ){
			# handle counter issues
			if( $me->{test}{calcdata}{lastv} < 0x7FFFFFFF ){
			    # assume reboot/reset
			    $transient = 1;
			}else{
			    # overflow/wrap-around
			    $dv = 0xFFFFFFFF - $me->{test}{calcdata}{lastv};
			    $dv += $value + 1;
			}
		    }else{
			$dv = $value - $me->{test}{calcdata}{lastv};
		    }
		}else{
		    $transient = 1;
		    $me->debug( "$tag TEST delta startup" );
		}
		if( $me->{test}{calcdata}{lastdv} && $dv > $me->{test}{calcdata}{lastdv} * 100 ){
		    # unusually large spike, probably a reset/reboot - supress
		    $transient = 1 if $me->{test}{spike_supress};
		    # NB: since we save this value, if it really is a valid large jump
		    # the right thing happens the next time we test
		}
		
		$me->{test}{calcdata}{lastv}  = $value;
		$me->{test}{calcdata}{lastdv} = $dv;
		
		if( $me->{test}{calc} =~ /rate/ && !$transient ){
		    $transient = 1 unless $me->{test}{calcdata}{lastt};
		    if( $transient ){
			$me->debug( "$tag TEST rate startup" );
		    }else{
			$dt = $^T - $me->{test}{calcdata}{lastt};
			$value = $dv / $dt;
		    }
		}else{
		    $value = $dv;
		}
		
		$me->{test}{calcdata}{lastt} = $^T;
		
		return $me->done() if $transient;
	    }
	    
	    # Why birds and beasts from quality and kind,
	    # Why old men fool and children calculate,
	    #   -- Shakespeare, Julius Ceasar
	    if( $me->{test}{calc} =~ /ave|jitter/ ){
		# moving average
		my $iv = $value;
		my $x = $me->{test}{alpha} * $me->{test}{calcdata}{ave};
		$x += $value;
		$x /= $me->{test}{alpha} + 1;
		$me->{test}{calcdata}{ave} = $x;
		$value = $x;

		if( $me->{test}{calc} =~ /jitter/ ){
		    $value = $value - $iv;
		    $value = - $value if $value < 0;
		}
	    }

	    
	    # Oh, Lord, bless this thy hand grenade that with it thou
	    # mayest blow thy enemies to tiny bits, in thy mercy.
	    #   -- Monty Python, Holy Grail
	    if( $me->{test}{calc} =~ /bits/ ){
		# convert Bytes -> bits
		$value *= 8;
	    }
	    
	    if( $me->{test}{calc} =~ /inet/ ){
		# convert -> IP addr (v4)
		$value = ::xxx_inet_ntoa( pack('N',$value) );
	    }
	}

	# done last, so user can post-diddle
	if( $me->{test}{perlexpr} ){
	    my $x = $value;
	    $value = eval $me->{test}{perlexpr};
	}
	
	$me->{test}{currvalue} = $value;	# to simplify debugging
	$me->{srvc}{result}    = $value;	# this is what gets handed to graphing engine
	$me->debug( "$tag TEST - curr $value" );
	
	# and finally test the value
	if( defined($me->{test}{expect}) ){
	    my $e = $me->{test}{expect};
	    # Thou sober-suited matron, all in black,
	    # And learn me how to lose a winning match,
	    #   -- Shakespeare, Romeo+Juliet
	    return $me->isdown( "$tag TEST did not match expected regex" )
		unless $value =~ /$e/;
	}
	if( defined($me->{test}{nexpect}) ){
	    my $e = $me->{test}{nexpect};
	    # He hath indeed better bettered expectation.
	    #   -- Shakespeare, Much Ado about Nothing
	    return $me->isdown( "$tag TEST matched unexpected regex" )
		if $value =~ /$e/;
	}
	# Lesser than Macbeth, and greater.
	#   -- Shakespeare, Macbeth
	if( defined($me->{test}{minvalue}) && $value < $me->{test}{minvalue} ){
	    return $me->isdown( "$tag TEST less than min" );
	}
	# The greater scorns the lesser
	#   -- Shakespeare, Timon of Athens
	if( defined($me->{test}{maxvalue}) && $value > $me->{test}{maxvalue} ){
	    return $me->isdown( "$tag TEST more than max" );
	}
	# Repugnant to command: unequal match'd
	#   -- Shakespeare, Hamlet
	if( defined($me->{test}{eqvalue}) && $value != $me->{test}{eqvalue} ){
	    return $me->isdown( "$tag TEST not equal" );
	}
	# In equal scale weighing delight and dole
	#   -- Shakespeare, Hamlet
	if( defined($me->{test}{nevalue}) && $value == $me->{test}{nevalue} ){
	    return $me->isdown( "$tag TEST equal" );
	}
	
	if( !$me->{test}{testedp} ){
	    # if no tests are specified, result is whether we recvd data or not
	    if( length($value) ){
		return $me->isup();
	    }else{
		return $me->isdown( "$tag TEST no data rcvd" );
	    }
	}
	return $me->isup();
    };
    if($@){
	return $me->isdown( "$tag TEST failure - $@" );
    }
}

################################################################

sub readconfig {
    my $cf  = shift;
    my $mom = shift;
    my $me  = new;
    my $more = shift;
    my( $line, $name, $type );
    
    $me->{parents} = [ $mom ] if $mom;

    $line = $cf->nextline();
    ($type, $name) = $line =~ /^\s*([^:\s]+):?\s+([^\{\s]+)/;
    $me->{type} = "\u\L$type";

    $me->{name} = $name;
    $me->{definedinfile} = $cf->{file};
    $me->{definedonline} = $cf->{line};
    $me->{definedattime} = $^T;
    
    if( $line =~ /\{/ ){
	while( defined($_ = $cf->nextline()) ){
	    # print STDERR "read service: $_\n" if $::opt_d;
	    if( /^\s*\}/ ){
		last;
	    }
	    elsif( /^cron\s/i ){
		$cf->ungetline($_);
		my $c = UserCron::readconfig($cf, $me);
		push @{ $me->{cronjobs} }, $c if $c;
	    }
	    
	    elsif( /:/ ){
		my($k, $v) = split /:\s*/, $_, 2;
		$cf->warning( "redefinition of parameter '$k'" )
		    if defined $me->{config}{$k};
		$me->{config}{$k} = $v;
	    }
	    else{
		eval{ $cf->error( "invalid entry in config file: '$_'" ); };
		$cf->eat_block() if /\{\s*$/;
		$me->{conferrs} ++;
		# attempt to continue
	    }
	}
    }

    return $me->config($cf, $more);
}

sub graphlist {
    my $me = shift;

    return () unless $me->{graph};
    ([$me, '']);
}

sub check_now {
    my $me = shift;

    return if $me->{srvc}{state} && $me->{srvc}{state} ne 'done';
    
    $me->{srvc}{nexttesttime} = $^T;
    $me->clear_timed_funcs();
    $me->me_start();
}

################################################################
sub cmd_update {
    my $ctl = shift;
    my $param = shift;

    my $x = $MonEl::byname{ $param->{object} };
    if( $x ){
	my $s = $param->{status};
	my $v = $param->{severity};

	if( $s ne 'up' && $s ne 'down' ){
	    $ctl->bummer( 500, 'invalid status' );
	}elsif( $x->can('update') ){
	    $x->update( $s, $v );
	    $ctl->ok_n();
	}else{
	    $ctl->bummer( 500, 'object not a service' );
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

################################################################
Doc::register( $doc );
Control::command_install( 'update',  \&cmd_update, 'set service status', 'object status severity' );

1;

