# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-02 17:11 (EST)
# Function: Monitor Element class
#
# $Id: MonEl.pm,v 1.128 2005/12/11 21:21:49 jaw Exp $

package MonEl;
@ISA = qw(Configable);

use Stats;
use Override;
use Web;
use Argus::Encode;
use POSIX;

use strict qw(refs vars);
use vars qw(@ISA $doc @all %byname %severity_sort);

@all = ();
%byname = ();

my $OLD_AGE = 3600 * 24 * 30;	# for janitorial cleanup

%severity_sort = ( clear => 0, warning => 1, minor => 2, major => 3, critical => 4 );

$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [ ],
    methods => {},
    conf => {
	quotp => 1,
	bodyp => 1,
    },
    fields  =>  {
	i_am_top => {},
	transient=> {
	    descr => 'object is temporary',
	},
	name     => {
	    descr=> 'relative name of this object',
	},
	type     => {
	    descr => 'type of object',
	},
	uname    => {
	    # will be same as name, except for services
	    descr => 'relative unique name for this object',
	    attrs => ['config'],
	    # eg. Group "Foo" {
	    #		Service HTTP
	    #		Service HTTP {
	    #			port: 8080
	    #  			uname: HTTP-2
	    #		}
	}, 
	unique   => {
	    descr => 'full unique name of this object',
	},
	parents  => {
	    descr => 'list of objects parents',
	},
	children => {
	    descr => 'list of objects children',
	},
	cronjobs => {
	    descr => 'list of cronjobs',
	},
	override => {
	    descr => 'override data',
	},
	anc_in_ov => {
	    descr => 'an ancestor is in override',
	},
	alarm    => {
	    descr => 'is the siren currently ringing',
	    attrs => ['bool'],
	},
	
	definedinfile => {
	    descr => 'file the object was defined in',
	},
	definedonline => {
	    descr => 'line number the object was defined on',
	},
	definedattime => {
	    descr => 'time the object was defined',
	},
	
	sort => {
	    descr => 'sort the entries on web page',
	    default => 'yes', # except for Top
	    attrs => ['config', 'bool'],
	},
	autogenerated => {
	    descr => 'was this object generated automagically',
	    # to be used by config file editing utilities
	    # or built-in web-based configurator (RSN)
	    default => 'no',
	    attrs => ['config', 'bool', 'inherit', 'nyi'],
	},
	overridable => {
	    descr => 'can this object be overridden', # but see also acl_override
	    attrs => ['config', 'bool'],
	    default => 'yes',
	    html  => 'override',
	},
	note => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config', 'inherit'],
	    versn => '3.3', # previously, not inherited
	    html  => 'webpretty',
	},
	info => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config'],
	    html  => 'webpretty',
	},
	comment => {
	    descr => 'informational text displayed on webpage',
	    attrs => ['config'],
	    html  => 'webpretty',
	},
	details => {
	    # expected to be a <A HREF="link">label</A>
	    descr => 'informational text displayed on webpage - usually a link to more details',
	    attrs => ['config', 'inherit'],
	    versn => '3.3', # previously, not inherited
	    html  => 'webpretty',
	},
	debug => {
	    descr => 'send all sorts of gibberish to the log',
	    # default => 'no',
	    attrs => ['config', 'bool'],
	    html  => 'troubleshooting',
	},
	flags => {
	    descr => 'various config data, summarized and displayed on webpage',
	    attrs => ['internal'],
	},
	passive => {
	    descr => 'marks object as passive - sets nostatus=yes, siren=no, sendnotify=no',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'no',
	},
	depends => {
	    descr => 'list of dependency objects',
	    exmpl => 'Top:Foo:SMTP  Top:Bar:HTTP  Top:Bar:IMAP',
	    attrs => ['config'],
	    versn => '3.2',
	},
	depend::culprit => {
	    descr => 'name of dependency object preventing us from transitioning to down',
	},
        depend::onme => {
	    descr => 'list of objects for which I am the dependency culprit',
	},
	
	# transition
	siren => {
	    descr => 'should alarm ring',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'on',
	},
	nostatus => {
	    descr => 'should the status be ignored',
	    attrs => ['config', 'inherit', 'bool'],
	    default => 'no',
	},
	# Change the gravitational constant of the universe!
	#   -- Q, Star Trek TNG
	gravity => {
	    descr => 'governs group state transitions: down => group is down if any child is down, up => group is up if any child is up',
	    attrs => ['config'],
	    default => 'down',
	    vals  => ['up', 'down'],
	    # down => object is down if any child is down, (even though some are up)
	    # up   => object is up if any child is up, (even though some are down)
	    #
	    # eg. set gravity=up if you want to notified only if ALL nameservers are down...
	},
	countstop => {
	    descr => 'do not recurse and count children in count mode (the numbers on Top webpage)',
	    attrs => ['config', 'bool'],
	    default => 'no',
	},
	
	status => {
	    descr => 'current real status',
	    vals  => ['up', 'down'], # degraded, attention, bouncing
	},
	ovstatus => {
	    descr => 'current status',
	    vals  => ['up', 'down', 'override'],
	},
	prevstatus   => {
	    descr => 'previous value of status',
	},
	prevovstatus => {
	    descr => 'previous value of ovstatus',
	},
	
	transtime => {
	    descr => 'time of last transition',
	},
	sirentime => {
	    descr => 'hush siren timestamp',
	},
	severity => {
	    descr => 'severity level of down state',
	    attrs => ['config', 'inherit'],
	    # ISO 10164-4
	    vals  => ['clear', 'warning', 'minor', 'major', 'critical'],
	    default => 'critical',
	    versn => '3.3',
	},
	currseverity => {
	    descr => 'current severity level',
	},
	
	# notification

	# message_fmt + message{up,dn} => %M
      notify::message_fmt => {
	  descr => 'format for notification messages',
	  attrs => ['config', 'inherit'],
	  default => '%i %m - %t',
	  versn => '3.3',
      },
      notify::message_fmtup => {
	  descr => 'format for up notification messages',
	  attrs => ['config', 'inherit'],
	  versn => '3.4',
      },
      notify::message_fmtdn => {
	  descr => 'format for down notification messages',
	  attrs => ['config', 'inherit'],
	  versn => '3.4',
      },
      notify::messageup => {
	  descr => 'message to transmit for UP notifications',
	  attrs => ['config'],
	  html  => 'notif',
      },
      notify::messagedn => {
	  descr => 'message to transmit for DOWN notifications',
	  # "Server Room is too Hot" may be better than "1.2.3.4:.1.2.4.6.8.35.17.24.7.1 is down"
	  # NB: messages can be emtpy, in which case nothing will be sent
	  attrs => ['config'],
	  html  => 'notif',
      },

      notify::message_lotsdn => {
	  descr => 'message to transmit for lots DOWN summary notifications',
	  attrs => ['config', 'top'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::message_lotsup => {
	  descr => 'message to transmit for lots UP summary notifications',
	  attrs => ['config', 'top'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::nolotsmsgs => {
	  descr => 'list all msgs, dont summarize into Lots DOWN/UP',
	  attrs => ['config', 'top', 'bool'],
	  html  => 'notif',
	  versn => '3.2.1',
      },
      notify::shortmessages => {
          descr => 'use shorter default notification messages',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  default => 'no',
	  html  => 'notif',
      },
	
      notify::notify => {
	  descr => 'list of addresses to notify: method:address method:address ...',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
      },
      notify::notifyalso => {
	  descr => 'list of addresses to notify in addition to notify, notifyup, notifydn',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2.1',
      },
      notify::notifyaudit => {
	  descr => 'list of addresses to notify with audit trail messages',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.3',
      },
      notify::notifyup => {
	  descr => 'list of addresses to notify when up',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::notifydn => {
	  descr => 'list of addresses to notify when down',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
	  versn => '3.2',
      },
      notify::mail_from => {
	  descr => 'address to use as From: on notification email',
	  attrs => ['config', 'inherit'],
	  versn => '3.1.3',
	  exmpl => 'joebob@example.com',
	  default => 'Argus',
	  html  => 'notif',
      },
      notify::renotify => {
	  descr => 're-send time period in seconds',
	  attrs => ['config', 'inherit'],
	  default => 300,
	  html  => 'notif',
      },
      notify::autoack => {
	  descr => 'do notifications not require ack',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'no',
	  html  => 'notif',
      },
      notify::ackonup => {
	  descr => 'automatically ack notifications when it comes up',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'no',
	  versn => '3.2',
      },
      notify::escalate => {
	  descr => 'list of times (in minutes) and addresses for notification escalation: time method:address ...; time method:address ...',
	  attrs => ['config', 'inherit'],
	  exmpl => '30 qpage:manager qpage:noc;  60 qpage:ceo',
	  html  => 'notif',
      },
      notify::sendnotify => {
	  descr => 'should notifications be sent for this object',
	  attrs => ['config', 'bool'],
	  # default varies by object, Services=>yes, Group=>no
	  html  => 'notif',
      },
      notify::sendnotify2 => {
	  descr => 'should notifications be sent for this Service',
	  attrs => ['config', 'bool', 'inherit'],
	  default => 'yes',
	  html  => 'notif',
      },
	
      notify::priority => {
	  # not used by internal notification methods, but is available
	  # for user defined methods to use as they see fit
	  descr => 'priority level of notifications',
	  attrs => ['config', 'inherit'],
	  html  => 'notif',
      },
      notify::timezone => {
	  descr => 'timezone to use in notification message times',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },

      notify::list => {
	  descr => 'list of all outstanding notifications',
      },
	
	# web page
      web::transtime => {
	  descr => 'last time the object changed',
      },
      web::bldtime   => {
	  descr => 'time the web page was last generated',
      },
      web::bldtimetop=> {
	  descr => 'time the web page (top version) was last generated',
      },

      # there is a reason there is both a header and header_all (likewise footer)
      # but I forget why....
      web::header => {
	  descr => 'stuff to put at the top of the webpage',
	  attrs => ['config'],
	  html  => 'webpretty',
      },
      web::footer => {
	  descr => 'stuff to put at the bottom of the webpage',
	  attrs => ['config'],
	  html  => 'webpretty',
      },
      web::header_all => {
	  descr => 'stuff to put at the top of the webpage',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::footer_all => {
	  descr => 'stuff to put at the bottom of the webpage',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::footer_argus => {
	  descr => 'argus version footer',
	  attrs => ['config', 'inherit'],
	  versn => '3.1.3',
	  default => "<P><FONT SIZE=\"-1\"><A HREF=\"$::ARGUS_URL\">".
	      "Argus</A>: $::VERSION</FONT></P>",
	  html  => 'webpretty',
      },
      web::showstats => {
	  descr => 'show stats on the web page',
	  attrs => ['config', 'bool'],
	  default => 'yes',
	  html  => 'webpretty',
      },
      web::shownotiflist => {
	  descr => 'show the list of notifications on the web page',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'webpretty',
      },
      web::hidden => {
	  attrs => ['config', 'bool'],
	  versn => '3.2',
      },
      web::alwaysbase => {
	  attrs => ['config', 'bool', 'inherit'],
	  versn => '3.2',
      },
      web::buttons_top_html => {
	  descr => 'html to place at the top of the web page buttons',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },
      web::buttons_bottom_html => {
	  descr => 'html to place at the bottom of the web page buttons',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
      },

      web::style_sheet => {
	  descr => 'web page style sheet',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
	  versn => '3.3',
      },
      web::bkgimage => {
	  descr => 'web page background image',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::refresh => {
	  descr => 'web page refresh period',
	  attrs => ['config', 'inherit'],
	  default => 60,
	  html  => 'webpretty',
      },
      web::icon => {
	  descr => '16x16 icon shown in some browsers',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::icon_up => {
	  descr => '16x16 icon shown in some browsers - when object is up',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::icon_down => {
	  descr => '16x16 icon shown in some browsers - when object is down',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::nospkr_icon => {
	  descr => 'hushed siren icon',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },
      web::sirensong => {
	  descr => 'wav file for browser to play when object is down',
	  attrs => ['config', 'inherit'],
	  html  => 'webpretty',
      },

      web::cachestale => {
	  # I don't want *any* cake
	  #   -- Monty Python, Meaning of Life
	  versn => '3.5',
	  descr => 'maximum age of cached web page before displaying a warning, in seconds',
	  attrs => ['config', 'inherit'],
	  default => 120,
      },
	
	label_left => {
	    descr => 'label to use on the left side of the webpage',
	    attrs => ['config'],
	},
	label_right => {
	    descr => 'label to use on the right side of the webpage',
	    attrs => ['config'],
	},
	label_right_maybe => {},
	label_left_maybe  => {},
	label => {
	    descr => 'label to use on right and/or left side of the webpage',
	    attrs => ['config'],
	},

	# AAA if more vxml params are added, these may be moved and renamed.
	# these are passed to vxml tts. ssml may be used if the tts engine suppports it.
	vxml_short_name => {
	    descr => 'short name for this object to be used in VXML TTS, may contain SSML',
	    exmpl => 'gee double you seven three',
	    attrs => ['config'],
	    versn => '3.5',
	},
	vxml_long_name => {
	    descr => 'long name for this object to be used in VXML TTS, may contain SSML',
	    exmpl => 'new york city router gee double you seven three',
	    attrs => ['config'],
	    versn => '3.5',
	},
	vxml_descr => {
	    descr => 'informational text to be used in VXML TTS, may contain SSML',
	    attrs => ['config'],
	    versn => '3.5',
	},	  
	
	#### ACLs
	acl_mode => {
	    descr => 'mode for access control list configuration',
	    attrs => ['config', 'inherit'],
	    vals  => ['simple', 'extended'],
	    default => 'simple',
	    versn => '3.1',
	    html  => 'acl',
	},

	# acl_mode = simple:
	acl_user => {
	    descr => 'simple mode access control list - read-only web page access',
	    attrs => ['config', 'acl'],
	    default => 'user staff root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_staff => {
	    descr => 'simple mode access control list - some read/write web page access',
	    attrs => ['config', 'acl'],
	    default => 'staff root',
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_root => {
	    descr => 'simple mode access control list - full web page access',
	    attrs => ['config', 'acl'],
	    default => 'root',
	    versn => '3.1',
	    html  => 'acl',
	},

	# acl_mode = extended:
	acl_page => {
	    descr => 'extended mode access control list - for web page access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_about => {
	    descr => 'extended mode access control list - for debugging page access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_getconf => {
	    descr => 'extended mode access control list - display config page access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_flush => {
	    descr => 'extended mode access control list - flush page access',
	    attrs => ['config', 'acl'],	
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_override => {
	    descr => 'extended mode access control list - set/clear override access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_annotate => {
	    descr => 'extended mode access control list - add/remove annotation access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_logfile => {
	    descr => 'extended mode access control list - logfile access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfylist => {
	    descr => 'extended mode access control list - notification list access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfyack => {
	    descr => 'extended mode access control list - ack notifications access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfyackall => {
	    descr => 'extended mode access control list - ack all notifications access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_ntfydetail => {
	    descr => 'extended mode access control list - notification details page access',
	    attrs => ['config', 'acl'],
	    versn => '3.1',
	    html  => 'acl',
	},
	acl_checknow => {
	    descr => 'extended mode access control list - check now access',
	    attrs => ['config', 'acl'],
	    versn => '3.5',
	    html  => 'acl',
	},
	
	# stats
	logsize => {
	    descr => 'Maximum number of log entries to keep',
	    default => 200,
	    attrs => ['config', 'inherit'],
	},
	nostats => {
	    descr => 'do not record any statistics',
	    attrs => ['config', 'bool'],
	    default => 'no',
	},
	
      stats::log => {
	  descr => 'object event log - array of [Time, status, ovstatus, tag, msg]',
      },
      stats::lasttime => {
	  descr => 'time stats were last updated',
      },
      stats::status   => {
	  descr => 'status at time of last stats update',
      },
      stats::daily    => {
	  descr => 'daily statistics',
      },
      stats::monthly  => {
	  descr => 'monthly statistics',
      },
      stats::yearly   => {
	  descr => 'yearly statistics',
      },

	graph => {
	    descr => 'generate graphs?',
	    attrs => ['config', 'bool', 'inherit'],
	    default => 'no',
	    versn => '3.2',
	    html  => 'graphing',
	},
      image::gr_what => {
	  descr => 'what should be graphed?',
	  attrs => ['config', 'inherit'],
	  vals  => ['result', 'elapsed', 'status'],
	  default => 'result',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_colors => {
	  descr => 'colors used on graphs - list of RRGGBB RRGGBB ...',
	  attrs => ['config', 'inherit'],
	  exmpl => 'FF2222  4456CC  CCFF44', 
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_range => {
	  descr => 'range of values for the y-axis on graphs ([min]-[max])',
	  attrs => ['config', 'inherit'],
	  exmpl => '0-1500',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::xlabel => {
	  descr => 'label to use on x-axis of graphs',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::ylabel => {
	  descr => 'label to use on y-axis of graphs',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::title => {
	  descr => 'title to put on graph',
	  attrs => ['config', 'inherit'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::logscale => { # NYI
	  descr => 'make the y-axis logarithmic on graphs',
	  attrs => ['config', 'inherit', 'bool', 'nyi'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::drawgrid => {
	  descr => 'draw a grid on the graphs',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gridontop => {
	  descr => 'draw grid over the graph',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::gr_binary => {
	  descr => 'label the graph y axis in powers of 2 (instead of powers of 10)',
	  attrs => ['config', 'inherit', 'bool'],
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::barstyle => {
	  descr => 'style of summary range bars, minimum/maximum, standard deviation, or none',
	  attrs => ['config', 'inherit'],
	  vals  => ['minmax', 'stddev', 'none'],
	  default => 'minmax',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::labelstyle => {
	  descr => 'style for graph labels',
	  attrs => ['config', 'inherit'],
	  vals  => ['text', 'box'],
	  default => 'box',
	  versn => '3.4',
	  html  => 'graphing',
      },
      image::whichgraphs => {
	  descr => 'which of the 3 graphs should be shown',
	  attrs => ['config', 'inherit'],
	  default => '123',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::transparent => {
	  descr => 'should the background of graphs be transparent',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'graphing',
      },
      image::drawborder => {
	  descr => 'draw a border on the graph image',
	  attrs => ['config', 'inherit', 'bool'],
	  default => 'yes',
	  versn => '3.2',
	  html  => 'graphing',
      },

	
################################################################
# misc
################################################################
        watch::watching => {},	# for ticket system interface
        watch::watched  => {},

    },
};

# what is my name?
sub unique {
    my $me = shift;
    my( $x, $n, $nn );
    
    return $me->{unique} if $me->{unique};

    if( $me->{parents} && $me->{parents}[0] ){
	$n = $me->{parents}[0]->unique();
	$n .= ':';
    }
    $nn = $me->{uname} || $me->{name};
    $nn =~ s/\s+/_/g;
    $nn =~ tr/\000-\037//d;
    $n .= $nn;
    $me->{unique} = $n;
    $n
}

# what is my file?
sub filename {
    my $me = shift;
    my $n = $me->unique();

    return encode( $n );
}

# what is my URL?
sub url {
    my $me = shift;
    my @param = @_;
    my $n = $me->filename();

    return "__BASEURL__?object=$n" . join(';', '', @param);
}

# What is the air-speed velocity of an unladen swallow?
sub air_speed_velocity {
    my $swallow = shift;
}

sub init {
    my $me = shift;
    my $cf = shift;
    my( $u, $k, $v );

    $me->init_from_config( $doc, '' );      # this may change uname
    $me->init_from_config( $doc, 'web' );
    $me->init_from_config( $doc, 'stats' );
    $me->init_from_config( $doc, 'notify' );
    $me->init_from_config( $doc, 'image' );
    $me->DARP_Misc::init() if $::HAVE_DARP;
    
    $me->init_acls();
    
    $me->{uname} ||= $me->{name};
    $u = $me->unique();
    if( $byname{$u} ){
	eval {
	    $cf->error( "Duplicate object '$u'" ) if $cf;
	};
	return undef;
    }

    $byname{$u} = $me;
    push @all, $me;

    $me->{children}  ||= []; # prevent warning
    $me->{label_left}  = $me->{label_left}  || $me->{label} || $me->{label_left_maybe};
    $me->{label_right} = $me->{label_right} || $me->{label} || $me->{label_right_maybe};
    
    $me->{status} = $me->{ovstatus} = 'up';
    $me->{alarm}  = 0;
    $me->{transtime} = $^T;
    $me->{sirentime} = $^T;
    $me->{graph}  = 0 unless $me->can('graph_add_sample');
    
    $me->{notify}{messageup} = ($me->{notify}{shortmessages} ?
                                  $me->{uname} : $me->unique()) . ' is UP'
                                      unless defined $me->{notify}{messageup};
    $me->{notify}{messagedn} = ($me->{notify}{shortmessages} ?
                                  $me->{uname} : $me->unique()) . ' is DOWN'
                                      unless defined $me->{notify}{messagedn};

    $me->{image}{title} = $me->{label_right}
    	unless defined $me->{image}{title};
    
    if( $me->{passive} ){
	$me->{flags} .= " *passive*";
	$me->{siren}    = 0;
	$me->{nostatus} = 1;
	$me->{notify}{sendnotify} = 0;
	# QQQ - set an override ?
    }
    
    $me->{flags} .= " status-ignored" if $me->{nostatus};
    $me->{flags} .= " gravity-up"     if $me->{gravity} eq 'up';
    $me->{flags} .= " siren-quiet"    unless $me->{siren};
    $me->{flags} .= " nostats"        if $me->{nostats};

    $me->{vxml_short_name} ||= $me->{uname};
    $me->{vxml_long_name}  ||= $me->unique();
    
    $me->check_typos( $cf ) if $cf;
    Doc::check( $me )       if $::opt_T;
    $me->stats_load();

    if( $me->can('init_hook') ){
	$me->init_hook($cf);
    }
    
    1;
}

END {
    deconfigure();
}

sub deconfigure {
    my @a = @all;

    foreach my $x (@a){
	$x->stats_update_and_maybe_roll();
	$x->stats_save();
	# $x->recycle();
    }
    Conf::deconfigure();
}


sub recycle {
    my $me = shift;
    my $cascade = shift;
    
    # remove myself from my parents and children
    foreach my $c (@{$me->{children}}){
	$c->{parents} = [ grep { $_ ne $me }
			  @{$c->{parents}} ];
	if( $cascade ){
	    $c->stats_update_and_maybe_roll();
	    $c->stats_save();
	    $c->recycle(1);
	}
    }
    foreach my $p (@{$me->{parents}}){
	$p->{children} = [ grep { $_ ne $me }
			   @{$p->{children}} ];
	$p->{web}{transtime} = $^T;	# force web page rebuild
    }
    
    $me->{children} = $me->{parents} = undef;
    $me->{notify}{list} = undef;
    delete $byname{ $me->unique() };
    @all = grep { $_ ne $me } @all;
}

sub debug {
    my $me  = shift;
    my $msg = shift;

    return unless $me->{debug} || $Conf::Config{debug};
    
    my $f = $me->{fd} ? fileno($me->{fd}) : '';
    $me->loggit( msg => "[$f] $msg",
		 tag => 'DEBUG' );
}

# { tag msg lpf slp }
# lpf: bool, log to logfile?
# slp: bool, add to object log?
# lss: log status
# also logs to syslog, consoles, STDERR (-f)
sub loggit {
    my $me = shift;
    my %p  = @_;
    my( $m, $msg );

    $msg = $p{msg} || $me->{ovstatus};

    $p{slp} ||= $p{objlog};
    $p{lpf} ||= $p{logfile};
    
    if( $p{slp} ){
	push @{$me->{stats}{log}}, [ $^T, $me->{status}, $me->{ovstatus}, $p{tag}, $msg ];
	# and trim...
	if( @{$me->{stats}{log}} > $me->{logsize} ){
	    my( $l );
	    
	    $l = @{$me->{stats}{log}};
	    splice @{$me->{stats}{log}}, 0, $l - $me->{logsize}, ();
	}
    }
    
    $m = $p{tag} . ($p{tag} ? ' - ' : '') .
	( $p{lss} ? "$me->{ovstatus} - " : '') .
	$me->unique() . " - $msg";
    
    ::loggit( $m, $p{lpf} );
}

# internally, only the extended version are used, in simple mode we calulate them from
# the specified simple set
# 
# user, staff, root =>
# page, about, getconf, flush, override, annotate, logfile, ntfylist, ntfyack, ntfyackall, ntfydetail

sub init_acls {
    my $me = shift;

    if( $me->{acl_mode} eq 'simple' ){

	$me->{acl_page}       = $me->{acl_user};
	
	$me->{acl_about}      =
	$me->{acl_getconf}    =
	$me->{acl_flush}      =
        $me->{acl_checknow}   =
	$me->{acl_ntfyackall} = $me->{acl_root};
	
	$me->{acl_override}   =
	$me->{acl_annotate}   =
	$me->{acl_logfile}    =
	$me->{acl_ntfylist}   =
	$me->{acl_ntfyack}    =
	$me->{acl_ntfydetail} = $me->{acl_staff};
    }
}


# how in such short time, From eve to morn has the sun made his transit?
#      -- Dante, Divine Comedy

# something changed, determine current status
sub transition {
    my $me = shift;
    my $by = shift;
    my( $c, %cr, %co, $ca, $csv, $mst );
    my( $nr, $no );

    $mst = $me->{sirentime} || 0;
    foreach $c (@{$me->{children}}){
	my $cc = $c;
	$cc = $c->aliaslookup() if $c->can('aliaslookup');
	next if $me->{nostatus};
	$cr{ $cc->{status} }++;
	$co{ $cc->{ovstatus} }++;
	$ca ++ if $cc->{alarm};
	
	my $cst = $cc->{sirentime} || 0;
	if( $cst > $mst && $cc->{alarm} ){
	    $mst = $cst;
	}
	$csv = $cc->{currseverity} if $cc->{ovstatus} eq 'down' &&
	    $severity_sort{$cc->{currseverity}} > $severity_sort{$csv};
    }

    # QQQ - other states: degraded? concerned?
    if( $me->{gravity} eq "down" ){
	$nr = $cr{down} ? 'down' : 'up';
	$no = $co{down} ? 'down' : $co{override} ? 'override' : 'up';
    }else{
	$nr = $cr{up}   ? 'up'   : 'down';
	# do not propagate child-override in up gravity, else large agregates will likely never show down
	$no = $cr{up}   ? 'up'   : 'down';

	$csv = $me->{severity};
    }

    if( $nr ne $me->{status} ){
	$me->{transtime} = $^T;
    }

    my $ps = $me->{status};
    my $po = $me->{ovstatus};
    $me->{status}   = $nr;
    $me->{ovstatus} = $no;
    
    if( $ca && ($me->{status} eq "down" && $me->{siren}) ){
	$me->{alarm} = 1;
	# this may get cleared later if there is an override
    }else{
	$me->{alarm} = 0;
    }

    if( $me->{ovstatus} eq 'down' ){
	$me->{currseverity} = $csv || 'critical';
    }else{
	$me->{currseverity} = 'clear';
    }
    
    $me->transition2();
    $me->{prevstatus}   = $ps;
    $me->{prevovstatus} = $po;
    $me->{sirentime} = $mst if $me->{alarm};
    
    $me->loggit( msg => ($by->{label_left} || $by->{label} || $by->{name}),
		 tag => 'TRANSITION',
		 lss => 1,
		 slp => 1 ) if $me->{prevovstatus} ne $me->{ovstatus};

    $me->transition_propagate();
}

sub transition2 {
    my $me = shift;

    if( $me->{override} ){
	# set override
	$me->{ovstatus} = 'override' unless $me->{status} eq 'up';

	# clear alarm, since we are in override
	$me->{alarm}    = 0;
	# clear severity
	$me->{currseverity} = 'clear';
	# clear override
	if( $me->{status} eq 'up' && $me->{override}{mode} eq 'auto' ){
	    $me->override_remove();
	    # $me->{prevovstatus} = 'override';
	}
    }

    delete $me->{depend}{culprit};
    $me->check_depends() if $me->{depends} && ($me->{status} eq 'down');
    
    # update stats
    $me->stats_transition();
    
    # webpage
    $me->{web}{transtime} = $^T;

    # Canst thou draw out leviathan with an hook?
    #   -- Job 41:1
    if( $me->can('transition_hook') ){
	# so user can diddle things
	$me->transition_hook();
    }
    
}

# That labour on the bosom of this sphere, To propagate their states
#     -- Shakespeare, Timon of Athens

# propagate transition change to parents
sub transition_propagate {
    my $me = shift;
    my( $p );

    # send page
    # NB - previously, this checked status, causing, if in override, a notify to
    # be created but immediately acked and not sent
    if( $me->{prevovstatus} && $me->{ovstatus} ne $me->{prevovstatus} ){

	# audit trail notify channel
	if( $me->{notify}{notifyaudit} ){
	    Notify::new( $me,
			 audit  => 1,
			 detail => "$me->{prevovstatus} -> $me->{ovstatus}",
			 );
	}

	if( $me->can('transition_audit_hook') ){
	    $me->transition_audit_hook();
	}
	
	# do not notify if an ancestor, or me is in override
	if( !$me->{anc_in_ov} && !$me->{override}
	# and not down/depends
	&& $me->{ovstatus} ne 'depends'
	){
	    # but not if I just came out of override to up
	    unless( $me->{prevovstatus} eq 'override' && $me->{ovstatus} eq 'up'
		    || $me->{prevovstatus} eq 'depends'  && $me->{ovstatus} eq 'up'
		    ){
		# QQQ - why is the above code so ugly and complex?
		# QQQ - should it all be kicked to N:new? (making that ugly and complex)
	      Notify::new( $me );
	    }
	}
    }
    
    # update hushed sirens if me transitions
    if( $me->{prevovstatus} && ($me->{ovstatus} ne $me->{prevovstatus})
	&& ($me->{ovstatus} eq 'down') && $me->{alarm} ){
	$me->{sirentime} = $^T; 
    }
    
    foreach $p ( @{$me->{parents}} ){
	$p->transition( $me );
    }

    # and notify anything depending on me
    if( $me->{ovstatus} eq 'up' ){
	foreach my $d (split /\s+/, $me->{depend}{onme}){
	    my $dx = $byname{$d};
	    next unless $dx;
	    next unless $dx->{ovstatus} eq 'depends';
	    $dx->transition( $dx->{status} );
	}
	delete $me->{depend}{onme};
    }
    
}

sub resolve_alii {
    my $me = shift;
    my $cf = shift;
    my( $c );

    if( $me->can('aliaslookup') ){
	$me->aliaslookup($cf);
    }
    foreach $c ( @{$me->{children}} ){
	$c->resolve_alii($cf);
    }
}

# The children of the porters: the children of Shallum, the children
# of Ater, the children of Talmon, the children of Akkub, the children
# of Hatita, the children of Shobai, in all an hundred thirty and
# nine.
#     -- Ezra 2:42
sub sort_children {
    my $me = shift;
    my( $c );

    if( $me->{sort} ){
	@{$me->{children}} = sort {
	    ($a->{label_left} || $a->{name}) cmp ($b->{label_left} || $b->{name})
	    } @{$me->{children}};
    }
    
    foreach $c ( @{$me->{children}} ){
	$c->sort_children();
    }
}

# need to make sure we recalc statuses as objects may have changed on disk
sub jiggle {
    my $me = shift;

    foreach my $c ( @{$me->{children}} ){
	$c->jiggle();
    }
}

sub jiggle_lightly {
    my $me = shift;
    my $jone;
    
    foreach my $c ( @{$me->{children}} ){
	if( $c->{children} && @{$c->{children}} ){
	    $c->jiggle_lightly();
	    $jone = 1;
	}
	elsif( ! $jone ){
	    $c->jiggle();
	    $jone = 1;
	}
	else{
	    jiggle_skip();
	}
    }
}
# this exists for profiling
sub jiggle_skip {}

sub check_depends {
    my $me = shift;
    
    # check dependencies
    foreach my $dn (split /\s+/, $me->{depends}){
	my $dp = $byname{$dn};
	next unless $dp;
	if( $dp->{ovstatus} ne 'up' ){
	    $me->{depend}{culprit} = $dn;
	    # QQQ - no clue. what to do, what to do.
	    # ovstatus should be changed, in case something depends on me
	    # and to reduce user confusion (?)
	    $me->{ovstatus} = 'depends';
	    $me->{alarm}    = 0;
	    $dp->{depend}{onme} .= ' ' . $me->unique();
	    return 1;
	}
    }

    undef;
}

sub resolve_depends {
    my $me = shift;
    my $cf = shift;
    my( $dt, @ndl );

    # check depend list. make sure targets are valid.
    if( $me->{depends} ){
	foreach my $d (split /\s+/, $me->{depends}){
	    my $x = $byname{$d};
	    
	    if( $x == $me ){
		eval{ $cf->error("Cannot depend on self (ignored)") };
		next;
	    }
	    if( $x ){
		
	    }else{
		$cf->warning("Cannot resolve dependency: $d");
	    }
	    # we keep it, even if invalid...
	    push @ndl, $d;
	}
	
	if( @ndl ){
	    # and we keep it in a string (not [obj, ...]) :
	    #  - keep recycle easier
	    #  - so we can depend on dynamically created/temporary objs
	    #  - etc?
	    $me->{depends} = join ' ', @ndl;
	}else{
	    delete $me->{depends};
	}
    }
    
    foreach my $c (@{$me->{children}}){
	$c->resolve_depends($cf);
    }
}

sub create_object {
    my $param = shift;
    my $me = {};
    my $cf = NullConf->new();
    my( $mom, $type );
    
    $me->{definedattime} = $^T;
    foreach my $k (keys %$param){
	my $v = $param->{$k};
	
	if( $k eq 'parent' ){
	    my $p = $MonEl::byname{$v};
	    $cf->error( 'parent not found' ) unless $p;
	    $me->{parents} = [ $p ];
	    $mom = $p;
	    next;
	}
	next if $k =~ /^(arguscgi|func|quiet|seqno)$/;
	if( $k =~ /^(error|name|type|notypos|definedinfile|definedonline|definedattime)$/ ){
	    $me->{$k} = $v;
	    next;
	}
	# if( $k =~ /^::=(.*)/ ){
	#     $me->{$1} = $v;
	#     next;
	# }
	next if $k =~ /^::/;
	
	$me->{config}{$k} = $v;
    }

    $cf->error( 'unspecified object type' ) unless $me->{type};
    $cf->error( 'no name' ) unless $me->{name};
    $type = $me->{type} eq 'Host' ? 'Group' : $me->{type};
    bless $me, $type;
    $cf->error( $cf->{error} || 'create failed' ) unless $me->config($cf);
    
    push @{$mom->{children}}, $me if $mom;
    $mom->{web}{transtime} = $^T  if $mom;	# force web page rebuild

    $byname{Top}->{definedattime} = $^T;
    $me;
}

sub check_now {
    my $me = shift;

    foreach my $c ( @{$me->{children}} ){
	$c->check_now();
    }
}

################################################################
# class methods
################################################################

# some cleaning down the tables with wet sponges
#   -- Homer, Odyssey
sub janitor {
    my( %files );

    %files = map { ($_->filename() => 1) } @all;
	
    # clean up orphaned html, stats + graph files
    foreach my $dir ( "$::datadir/html",  "$::datadir/stats",
		      "$::datadir/gdata", "$::datadir/gcache" ){
	opendir(MD, $dir);
	foreach my $f (readdir(MD)){
	    my $fb = $f;
	    $fb =~ s/\.(base|top)$//;
	    $fb =~ s/\.(full|thumb)\.png$//;
	    next if $f =~ /^\./;
	    next if $files{$fb};
	    next if $^T - (stat("$dir/$f"))[9] < $OLD_AGE;
	    unlink "$dir/$f";
	}
	closedir MD;
    }
    
}

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

sub cmd_list {
    my $ctl = shift;
    my( $x );
    
    $ctl->ok();

    foreach $x (@all){
	$ctl->write( $x->unique() . "\n" );
    }
    $ctl->final();
}

sub cmd_children {
    my $ctl = shift;
    my $param = shift;
    my( $x, $c );

    $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	foreach $c ( @{$x->{children}} ){
	    $ctl->write( $c->unique() . "\n" );
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub more_about_whom {
    my $me  = shift;
    my $ctl = shift;
    my @who = @_;

    WHO: foreach my $b (@who){
	my $x = $me;
	my @b = split /::/, $b;
	foreach my $p (@b){
	    next WHO unless $x->{$p};
	    $x = $x->{$p};
	}

	foreach my $k (sort keys %$x) {
	    my $v = $x->{$k};
	    next unless defined $v;
	    next if $b eq 'snmp' && $k =~ /community|snmppass|snmpprivpass/ && $Conf::Config{_hide_comm};
	    
	    if( ref($v) ){
		$v = '#<REF>';
	    }else{
		$v = encode( $v );
	    }
	    $ctl->write( "${b}::$k:\t$v\n" );
	}
    }
}

sub cmd_about {
    my $ctl = shift;
    my $param = shift;
    my( $b, $x, $k, $v );
    
    $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	if( $x->{i_am_top} && (!$Conf::Config{_no_addtnl} || $param->{argusctl}) ){
	    # maybe dump some additional debugging info
	    $ctl->write( "__version_perl:\t" .
			 ( $^V ? join('.', unpack('c*', $^V)) : $] ) . "\n");
	    $ctl->write( "__version_argus:\t$::VERSION\n" );
	    $ctl->write( "__uptime:\t" . elapsed($^T - $::starttime) . " / " .
			 elapsed($^T - $::mainstart) . "\n" );
	    $ctl->write( "__osinfo:\t$::OSINFO\n" );
	    # ...
	}
	
	foreach $b ('', 'override', 'stats', 'web', 'notify', 'image', 'depend', 'bios'){
	    next unless !$b || $x->{$b};
	    foreach $k (sort ($b ? (keys %{$x->{$b}}) : (keys %$x))){
		$v = $b ? $x->{$b}{$k} : $x->{$k};
		next unless defined $v;
		if( ref($v) ){
		    $v = "#<REF>";
		}else{
		    # QQQ - or some other encoding scheme?
		    $v = encode( $v );
		}
		$ctl->write( $b ? "${b}::$k:\t$v\n" : "$k:\t$v\n" );
	    }
	}
	$x->about_more($ctl) if $x->can('about_more');
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_annotate {
    my $ctl = shift;
    my $param = shift;
    
    my $x = $byname{ $param->{object} };
    if( $x ){
	if( $param->{text} ){
	    $ctl->ok_n();
	    $x->{annotation} = $param->{text};
	    # splitting onto 2 lines looks nicer
	    $x->loggit( msg => "annotation: $param->{text}",
			tag => 'ANNOTATION',
			slp => 1 );
	    $x->loggit( msg => "annotation added by $param->{user} ",
			tag => 'ANNOTATION',
			slp => 1 );
	    $x->{web}{transtime} = $^T;
	}elsif( $x->{annotation} ){
	    # clear annotation
	    $ctl->ok_n();
	    delete $x->{annotation};
	    $x->{web}{transtime} = $^T;
	    $x->loggit( msg => "annotation cleared by $param->{user}",
			tag => 'ANNOTATION',
			slp => 1 );
	}else{
	    $ctl->bummer(404, 'No annotation');
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# spit out config data - in pretty config file format
sub cmd_getconf {
    my $ctl = shift;
    my $param = shift;
    my( $c );
    
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$c = $x->gen_conf(0);
	$c =~ s/^\s*(community|snmppass|snmpprivpass):.*\n//gm if $Conf::Config{_hide_comm};
	$c =~ s/^/-/gm;
	$ctl->write( $c );
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# spit out config data - in 'key: value' form
sub cmd_getconfdata {
    my $ctl = shift;
    my $param = shift;
    my( $c );
    
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$ctl->write("type:\t$x->{type}\n");
	$ctl->write("name:\t$x->{name}\n");
	$ctl->write("parent:\t". $x->{parents}[0]->unique() ."\n")
	    if $x->{parents} && $x->{parents}[0];
	foreach my $k (sort keys %{$x->{config}}){
	    my $v = $x->{config}{$k};
	    next unless defined $v;
	    $v = encode($v);
	    $ctl->write("$k:\t$v\n");
	}
	if( $x->{i_am_top} ){
	    foreach my $k (sort keys %Conf::Config ){
		my $v = $Conf::Config{$k};
		next unless defined $v;
		$v = encode($v);
		$ctl->write("::$k:\t$v\n");	# QQQ
	    }
	}
	if( $param->{andmore} ){
	    $ctl->write("::_uname:\t" . $x->unique() . "\n");
	    $ctl->write("definedattime:\t$x->{definedattime}\n");
	    if( $::HAVE_DARP && exists $ctl->{darpm} ){
		my $t = $ctl->{darpm}{slave}->{darpc}{tag};
		$ctl->write("::=status:\t" . $x->{darp}{statuses}{$t} . "\n");
	    }
	    # ...
	}
	
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub getparam {
    my $me = shift;
    my $p  = shift;

    my @p = split /::/, $p;
    my $r = $me;
    foreach my $z (@p){
	if( $z =~ /^\d+$/ ){
	    die \ 'Param Not Found'
		unless ref($r) && defined( $r->[$z] );
	    $r = $r->[$z];
	}else{
	    die \ 'Param Not Found'
		unless ref($r) && exists( $r->{$z} );
	    $r = $r->{$z};
	}
    }
    return $r;
}

# NB: getparam and setparam are useful for debugging...
#     getparam is used by cgi to get various things...
sub cmd_getparam {
    my $ctl = shift;
    my $param = shift;
    my( $x, $p, $r );

    if( $param->{object} eq 'Conf' ){
	$x = \%Conf::Config;
    }else{
	$x = $byname{ $param->{object} };
    }
    
    if( $x ){
	$p = decode( $param->{param} );
	eval {
	    $r = getparam( $x, $p );
	};
	if( $@ ){
	    return $ctl->bummer(404, ${$@} );
        }  
	$ctl->ok();
        $ctl->write( "param: $param->{param}\n" );
        $ctl->write( "object: $param->{object}\n" );
	$ctl->write( "value: " . encode($r) . "\n" );
        $ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# setparam should be used with extreme caution, you can cause serious damage...  
# perhaps it should be removed/disabled in non-development versions?
# hmmm, well for now, here is a gun, don't shoot your foot.
sub cmd_setparam {
    my $ctl = shift;
    my $param = shift;
    my( $x, $z, $fz, $r, $rfr, $p, $v, @p );

    if( $param->{object} eq 'Conf' ){
	$x = \%Conf::Config;
    }else{
	$x = $byname{ $param->{object} };
    }
    $v = decode( $param->{value} );
    if( $x ){
	$p = decode( $param->{param} );
	@p = split /::/, $p;
	$r = $x;
	$fz = pop @p;
	foreach $z (@p){
	    if( $z =~ /^\d+$/ ){
		return $ctl->bummer(404, 'Param Not Found')
		    # see comment above, Re: exists() in 5.00503
		    unless ref($r) && defined( $r->[$z] );
		$r = $r->[$z];
	    }else{
		return $ctl->bummer(404, 'Param Not Found')
		    unless ref($r) && exists( $r->{$z} );
		$r = $r->{$z};
	    }
	}
	return $ctl->bummer(404, 'Param Not Found')
	    unless ref($r);
	$r->{$fz} = $v;
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub childrenparam {
    my $me  = shift;
    my $ctl = shift;
    my $p   = shift;
    my $all = shift;
    my( $r );

    eval {
	$r = $me->getparam($p);
	$ctl->write( $me->unique() . ": " . encode($r) . "\n" );
    };
    if( $@ ){
	$ctl->write( $me->unique() . ": #<${$@}>\n" ) if $all;
    }

    foreach my $c (@{$me->{children}}){
	$c->childrenparam($ctl, $p, $all);
    }
}

sub cmd_getchildrenparam {
    my $ctl = shift;
    my $param = shift;

    my $p = $param->{param};
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	$x->childrenparam($ctl, $p, $param->{all});
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_getchildrenparamnr {
    my $ctl   = shift;
    my $param = shift;

    my $p = $param->{param};
    my $x = $byname{ $param->{object} };
    if( $x ){
	$ctl->ok();
	foreach my $c (@{$x->{children}}){
	    eval {
		my $r = $c->getparam($p);
		$ctl->write( $c->unique() . ": " . encode($r) . "\n" );
	    };
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

# generate list of services for generating composite group graph
# see cmd_graphdata
sub graphlist {	# virtual function, overridden by S::
    my $me = shift;
    my( @c );

    return unless $me->{graph};
    foreach my $c (@{$me->{children}}){
	my $cc = $c;
	# if an alias, pass through, but use the label of the alias
	$cc = $c->aliaslookup() if $c->can('aliaslookup');	
	my @x = $cc->graphlist();
	foreach my $x (@x){
	    $x->[1] = ($c->{label_right} || $c->{label} || $c->{name})
		. ($x->[1] ? ':' . $x->[1] : '');
	}
	push @c, @x;
    }
    @c;
}

# spit out data used to generate graphs
sub cmd_graphdata {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	if( $x->{graph} && $::HAVE_GD ){
	    $ctl->ok();
	    my @g = $x->graphlist();
	    $ctl->write( "list: ". join(' ', map {$_->[0]->filename()} @g) . "\n" );
	    $ctl->write( "clabels: ". join(' ', map {encode($_->[1])} @g) . "\n" );
	    $ctl->write( "header: ". encode("$x->{web}{header_all} $x->{web}{header}") . "\n");
	    $ctl->write( "footer: ". encode("$x->{web}{footer} $x->{web}{footer_all} " .
						  "$x->{web}{footer_argus}") . "\n");
	    $ctl->write( "bkgimg: ". encode($x->{web}{bkgimage}) . "\n");
	    $ctl->write( "style_sheet: ". encode($x->{web}{style_sheet}) . "\n");
	    $ctl->write( "icon: ". encode($x->{web}{icon}) . "\n");
	    $ctl->write( "picasso: ".encode($Conf::Config{picasso_prog}) . "\n")
		if $Conf::Config{picasso_prog};
	    
	    foreach my $k (keys %{$x->{image}} ){
		$ctl->write("$k:\t" . encode($x->{image}{$k}) ."\n" );
	    }

	    if( $x->{darp} && $x->{darp}{tags} ){
		my $t = join( ' ', map{ encode($_) } (sort keys %{$x->{darp}{tags}}) );
		$ctl->write("taglist: $t\n");
	    }
	    
	    $ctl->final();
	}else{
	    $ctl->bummer(404, 'Object Not Graphable');
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_jiggle {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->jiggle();
	$x->sort_children();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_sort {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->sort_children();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_recycle {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->loggit( msg => "Recycling Object",
		    tag => 'DELETE' ) unless $param->{quiet};
	if( $param->{cascade} || ! @{$x->{children}} ){
	    $x->stats_update_and_maybe_roll();
	    $x->stats_save();
	    $x->recycle($param->{cascade});
	    $byname{Top}->{definedattime} = $^T;
	    $ctl->ok_n();
	}else{
	    $ctl->bummer(500, 'children present');
	}
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_add_object {
    my $ctl = shift;
    my $param = shift;

    eval {
	my $obj = create_object( $param );
	$obj->loggit( msg => "Created $param->{type} $obj->{name}",
		      tag => 'CREATE' ) unless $param->{quiet};
    };
    if( $@ ){
	my $msg = $@->{error};
	$ctl->bummer(500, $msg);
    }else{
	$ctl->ok_n();
    }
}

sub cmd_loggit {
    my $ctl = shift;
    my $param = shift;

    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->loggit( %$param );
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}
    

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

# debugging...
sub cmd_svnotsched {
    my $ctl = shift;
    my $param = shift;
    my( $n, %sc );

    $ctl->ok();
    foreach my $x ( @BaseIO::bytime ){
	next unless $x;
	next if $x->{text} eq 'cron';
	$sc{ $x->{obj}->unique() } ++;
    }
    foreach my $x (@all){
	next unless $x->isa('Service');
	$n++;
	next if $sc{ $x->unique() };
	$ctl->write( $x->unique() . "\n" );
    }
    $ctl->write( "out of $n services total\n" );
    $ctl->final();
}

sub cmd_summary {
    my $ctl = shift;
    my $param = shift;
    my( %cs );
    
    my $x = $byname{ $param->{object} };
    if( $x ){
	# return same numbers as on web page
	for my $c (@{$x->{children}}){
	    my $cc = $c;
	    $cc = $c->aliaslookup() if $c->can('aliaslookup');
	    
	    if( $cc->{countstop} ){
		$cs{ $cc->{ovstatus} } ++;
		next;
	    }
	    
	    if( ! @{$cc->{children}} ){
		$cs{ $cc->{ovstatus} } ++;
		next;
	    }
	    
	    if( $cc->{override} ){
		$cs{override} += @{$cc->{children}};
		next;
	    }
	    
	    foreach my $gc ( @{$cc->{children}} ){
		my $gcc = $gc;
		$gcc = $gc->aliaslookup() if $gc->can('aliaslookup');
		$cs{ $gcc->{ovstatus} } ++;
	    }
	}
	$ctl->ok();
	$ctl->write( "status: $x->{ovstatus}\n" );
	foreach my $s ('up', 'down', 'override'){
	    $cs{$s} ||= '0';
	    $ctl->write( "$s: $cs{$s}\n" );
	}
	$ctl->final();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

sub cmd_check_now {
    my $ctl = shift;
    my $param = shift;
    my( %cs );
    
    my $x = $byname{ $param->{object} };
    if( $x ){
	$x->check_now();
	$ctl->ok_n();
    }else{
	$ctl->bummer(404, 'Object Not Found');
    }
}

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

Control::command_install( 'list',     \&cmd_list,
			  "return all objects" );
Control::command_install( 'children', \&cmd_children,
			  "return all children of specified object", "object" );
Control::command_install( 'about',    \&cmd_about,
			  "return internal data fields of specified object", "object" );
Control::command_install( 'annotate', \&cmd_annotate,
			  "add an annotation to an object--this will show on the webpage",
			  "object user text" );
Control::command_install( 'getconf',  \&cmd_getconf,
			  "return the config data for an object", "object" );
Control::command_install( 'getconfigdata', \&cmd_getconfdata,
			  'return the config data for an object', "object" );
Control::command_install( 'getparam', \&cmd_getparam );
Control::command_install( 'setparam', \&cmd_setparam );
Control::command_install( 'getchildrenparam', \&cmd_getchildrenparam );
Control::command_install( 'getchildrenparamnr', \&cmd_getchildrenparamnr );
Control::command_install( 'add_object', \&cmd_add_object );
Control::command_install( 'recycle',  \&cmd_recycle );
Control::command_install( 'jiggle',   \&cmd_jiggle );
Control::command_install( 'sort',     \&cmd_sort );
Control::command_install( 'graphdata',\&cmd_graphdata,
			  'return graphing data', 'object');
Control::command_install( 'loggit',   \&cmd_loggit, 'add message to log',
			  'object msg lpf slp lss tag' );
Control::command_install( 'summary',  \&cmd_summary, 'how many up, how many down, ...', 'object');
Control::command_install( 'svnsch',   \&cmd_svnotsched );
Control::command_install( 'checknow', \&cmd_check_now, 'check now', 'object');

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

Doc::register( $doc );

Cron->new( freq => 24*3600,
	   text => 'Monitor Element cleanup',
	   func => \&janitor,
	   );
1;
