package Mon::Client;

=head1 NAME

Mon::Client - Methods for interaction with Mon client

=head1 SYNOPSIS

    use Mon::Client;

=head1 DESCRIPTION

    Mon::Client is used to interact with "mon" clients. It supports
    a protocol-independent API for retrieving the status of the mon
    server, and performing certain operations, such as disableing hosts
    and service checks.

=head1 METHODS

=over 4

=item new

Creates a new object.

=item password (pw)

If I<pw> is provided, sets the password. Otherwise, returns the
currently set password.

=item host (host)

If I<host> is provided, sets the mon host. Otherwise, returns the
currently set mon host.


=item port (portnum)

If I<portnum> is provided, sets the mon port number. Otherwise, returns the
currently set port number.


=item username (user)

If I<user> is provided, sets the user login. Otherwise, returns the
currently set user login.

=item prot

If I<protocol> is provided, sets the protocol, specified by a fraction
(e.g. 0.37). Otherwise, returns the currently set protocol.

=item version

Returns the protocol version of the remote server.

=item error

Returns the error string from set by the last method, or undef if
there was no error.

=item connected

Returns 0 (not connected) or 1 (connected).

=item connect

Connects to the server. If B<host> and B<port> have not
been set, uses the defaults. Returns I<undef> on error.

=item disconnect

Disconnects from the server. Return I<undef> on error.

=item login ( [%hash] )

B<%hash> is optional, but if specified, should contain two keys,
B<username> and B<password>.

Performs the "login" command to authenticate the user to the server.
Uses B<username> and B<password> if specified, otherwise uses
the username and password previously set by those methods, respectively.


=item disable_watch ( watch )

Disables B<watch>.

=item disable_service ( watch, service )

Disables a service, as specified by B<watch> and B<service>.


=item disable_host ( host )

Disables B<host>.

=item enable_watch ( watch )

Enables B<watch>.

=item enable_service ( watch, service )

Enables a service as specified by B<watch> and B<service>.

=item enable_host ( host )

Enables B<host>.

=item quit

Logs out of the server. This method should be followed
by a call to the B<disconnect> method.

=item list_descriptions

Returns a hash of service descriptions, indexed by watch
and service. For example:

    %desc = $mon->list_descriptions;
    print "$desc{'watchname'}{'servicename'}\n";


=item list_group ( hostgroup )

Lists members of B<hostgroup>. Returns an array of each
member.

=item list_opstatus

Returns a hash of per-service operational statuses, as indexed by
watch and service.

    %s = $mon->list_opstatus;
    foreach $watch (keys %s) {
    	foreach $service (keys %{$s{$watch}}) {
	    foreach $var (keys %{$s{$watch}{$service}}) {
	    	print "$watch $service $var=$s{$watch}{$service}{$var}\n";
	    }
	}
    }

=item list_failures

Returns a hash in the same manner as B<list_opstatus>, but only
the services which are in a failure state.

=item list_successes

Returns a hash in the same manner as B<list_opstatus>, but only
the services which are in a success state.

=item list_disabled

Returns a hash of disabled watches, services, and hosts.

    %d = $mon->list_disabled;

    foreach $group (keys %{$d{"hosts"}}) {
    	foreach $host (keys %{$d{"hosts"}{$group}}) {
	    print "host $group/$host disabled\n";
	}
    }

    foreach $watch (keys %{$d{"services"}}) {
    	foreach $service (keys %{$d{"services"}{$watch}}) {
	    print "service $watch/$service disabled\n";
	}
    }

    for (keys %{$d{"watches"}}) {
    	print "watch $_ disabled\n";
    }

=item list_alerthist

Returns an array of hash references containing the alert history.

    @a = $mon->list_alerthist;

    for (@a) {
    	print join (" ",
	    $_->{"watch"},
	    $_->{"service"},
	    $_->{"time"},
	    $_->{"alert"},
	    $_->{"args"},
	    $_->{"summary"},
	    "\n",
	);
    }

=item list_failurehist

Returns an array of hash references containing the failure history.

    @f = $mon->list_failurehist;

    for (@f) {
    	print join (" ",
	    $_->{"watch"},
	    $_->{"service"},
	    $_->{"time"},
	    $_->{"summary"},
	    "\n",
	);
    }

=item list_pids

Returns an array of hash references containing the list of process IDs
of currently active monitors run by the server.

    @p = $mon->list_pids;

    $server = shift @p;

    for (@p) {
    	print join (" ",
	    $_->{"watch"},
	    $_->{"service"},
	    $_->{"pid"},
	    "\n",
	);
    }

=item list_state

Lists the state of the scheduler.

    @s = $mon->list_state;

    if ($s[0] == 0) {
    	print "scheduler stopped since " . localtime ($s[1]) . "\n";
    }

=item start

Starts the scheduler.

=item stop

Stops the scheduler.

=item reset

Resets the server.

=item reload

Causes the server to reload its configuration.

=item term

Terminates the server.

=item set_maxkeep

Sets the maximum number of history entries to store in memory.

=item get_maxkeep

Returns the maximum number of history entries to store in memory.

=item test ( group, service )

Schedules a service to run immediately.

=item ack ( group, service, text )

When B<group/service> is in a failure state,
acknowledges this with B<text>, and disables all further
alerts during this failure period.

=item loadstate ( state )

Loads B<state>.

=item savestate ( state )

Saves B<state>.

=item servertime

Returns the time on the server using the same output as the
time(2) system call.

=back

=cut

#
# Perl module for interacting with a mon server
#
# $Id: Client.pm,v 1.12 1999/03/22 00:09:45 trockij Exp $
#
# Copyright (C) 1998 Jim Trocki
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#

require 5.004;

use strict;
use vars qw($VERSION);
use IO::File;
use Socket;
use Text::ParseWords;

$VERSION = "0.01";


sub _sock_write;
sub _sock_readline;
sub _do_cmd;
sub _list_opstatus;
sub _start_stop;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};

    if ($ENV{MONHOST}) {
	$self->{HOST} = $ENV{MONHOST};
    } else {
	$self->{HOST} = undef;
    }

    $self->{CONNECTED} = undef;
    $self->{HANDLE} = new IO::File;

    $self->{PORT} = getservbyname ("mon", "tcp") || 2583;
    $self->{PROT} = undef;
    $self->{PASSWORD} = undef;
    $self->{USERNAME} = undef;
    $self->{DESCRIPTIONS} = undef;
    $self->{GROUPS} = undef;
    $self->{ERROR} = undef;
    $self->{VERSION} = undef;

    if ($ENV{USER}) {
    	$self->{USERNAME} = $ENV{USER};
    } else {
    	$self->{USERNAME} = (getpwuid ($<))[0];
    }

    $self->{OPSTATUS} = undef;
    $self->{DISABLED} = undef;

    bless ($self, $class);
    return $self;
}

sub password {
    my $self = shift;
    if (@_) { $self->{PASSWORD} = shift }
    return $self->{PASSWORD};
}

sub host {
    my $self = shift;
    if (@_) { $self->{HOST} = shift }
    return $self->{HOST};
}

sub port {
    my $self = shift;
    if (@_) { $self->{PORT} = shift }
    return $self->{PORT};
}

sub username {
    my $self = shift;
    if (@_) { $self->{USERNAME} = shift }
    return $self->{USERNAME};
}

sub prot {
    my $self = shift;
    if (@_) { $self->{PROT} = shift }
    return $self->{PROT};
}

sub DESTROY {
    my $self = shift;

    if ($self->{CONNECTED}) { $self->disconnect; }
}

sub error {
    my $self = shift;

    return $self->{ERROR};
}

sub connected {
    my $self = shift;

    return $self->{CONNECTED};
}


sub connect {
    my $self = shift;
    my ($iaddr, $paddr, $proto);

    undef $self->{ERROR};

    if ($self->{HOST} eq "") {
    	$self->{ERROR} = "no host defined";
	return undef;
    }

    if (!defined ($iaddr = inet_aton ($self->{HOST}))) {
	$self->{ERROR} = "could not resolve host";
    	return undef;
    }

    if (!defined ($paddr = sockaddr_in ($self->{PORT}, $iaddr))) {
	$self->{ERROR} = "could not generate sockaddr";
    	return undef;
    }

    if (!defined ($proto = getprotobyname ('tcp'))) {
	$self->{ERROR} = "could not getprotobyname for tcp";
    	return undef;
    }

    if (!defined socket ($self->{HANDLE}, PF_INET, SOCK_STREAM, $proto)) {
	$self->{ERROR} = "could not create socket: $!";
    	return undef;
    }

    if (!defined connect ($self->{HANDLE}, $paddr)) {
	$self->{ERROR} = "could not connect: $!";
    	return undef;
    }

    $self->{CONNECTED} = 1;
}


sub disconnect {
    my $self = shift;

    undef $self->{ERROR};

    if (!defined close ($self->{HANDLE})) {
	$self->{ERROR} = "could not close: $!";
    	return undef;
    }

    $self->{CONNECTED} = 0;

    return 1;
}


sub login {
    my $self = shift;
    my %l = @_;
    my ($r, $l);

    undef $self->{ERROR};

    $self->{"USERNAME"} = $l{"username"} if (defined $l{"username"});
    $self->{"PASSWORD"} = $l{"password"} if (defined $l{"password"});

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if (!defined $self->{USERNAME} || $self->{USERNAME} eq "") {
    	$self->{ERROR} = "no username";
	return undef;
    }

    if (!defined $self->{PASSWORD} || $self->{PASSWORD} eq "") {
    	$self->{ERROR} = "no password";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "login $self->{USERNAME} $self->{PASSWORD}");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }
}


sub disable_watch {
    my $self = shift;
    my ($watch) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($watch !~ /\S+/) {
    	$self->{ERROR} = "invalid watch";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "disable watch $watch");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub disable_service {
    my $self = shift;
    my ($watch, $service) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($watch !~ /\S+/) {
    	$self->{ERROR} = "invalid watch";
	return undef;
    }

    if ($service !~ /\S+/) {
    	$self->{ERROR} = "invalid service";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "disable service $watch $service");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub disable_host {
    my $self = shift;
    my (@hosts) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "disable host @hosts");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub enable_watch {
    my $self = shift;
    my ($watch) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($watch !~ /\S+/) {
    	$self->{ERROR} = "invalid watch";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "enable watch $watch");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub enable_service {
    my $self = shift;
    my ($watch, $service) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($watch !~ /\S+/) {
    	$self->{ERROR} = "invalid watch";
	return undef;
    }

    if ($service !~ /\S+/) {
    	$self->{ERROR} = "invalid service";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "enable service $watch $service");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub enable_host {
    my $self = shift;
    my (@hosts) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "enable host @hosts");

    if (!defined $r) {
	$self->{ERROR} = "error ($l)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}

sub version {
    my $self = shift;
    my $version = shift;
    
    undef $self->{ERROR};

    if (defined($version)) {
    	$self->{VERSION} = $version;
	return $self->{VERSION};
    }

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    unless (defined($self->{VERSION})) {
	my ($r, $l);
	($r, $l) = _do_cmd ($self->{HANDLE}, "version");

	if (!defined $r) {
	    $self->{ERROR} = "error ($l)";
	    return undef;
	} elsif ($r !~ /^220/) {
	    $self->{ERROR} = $r;
	    return undef;
	}
	($self->{VERSION} = $l) =~ s/^version\s+//;;
    }

    return $self->{VERSION};
}


sub quit {
    my $self = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "quit");

    return $r;
}


sub list_descriptions {
    my $self = shift;
    my ($r, @d, $d, $group, $service, $desc, %desc);

    undef $self->{ERROR};

    if ($self->version < 0.38) {
    	$self->{ERROR} = "list descriptions not supported";
	return undef;
    }

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @d) = _do_cmd ($self->{HANDLE}, "list descriptions");

    if (!defined $r) {
	$self->{ERROR} = "error (@d)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r if (!defined $r);

    foreach $d (@d) {
	($group, $service, $desc) = split (/\s+/, $d, 3);
	$desc{$group}{$service} = $desc;
    }

    return %desc;
}


sub list_group {
    my $self = shift;
    my ($group) = @_;

    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($group eq "") {
    	$self->{ERROR} = "invalid group";
    	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "list group $group");

    if ($r =~ /^220/) {
    	$l =~ s/^hostgroup\s+//;;
	return $l;
    } else {
	$self->{ERROR} = $l;
    	return undef;
    }

    return split (/\s+/, $l);
}


sub list_opstatus {
    my $self = shift;

    _list_opstatus($self, "list opstatus");
}


sub list_failures {
    my $self = shift;

    _list_opstatus($self, "list failures");
}


sub list_successes {
    my $self = shift;

    _list_opstatus($self, "list successes");
}


sub list_disabled {
    my $self = shift;
    my ($r, @d, %disabled, $h);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @d) = _do_cmd ($self->{HANDLE}, "list disabled");

    if (!defined $r) {
	$self->{ERROR} = $d[0];
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    foreach $r (@d) {
    	if ($r =~ /^group (\S+): (.*)$/) {
	    foreach $h (split (/\s+/, $2)) {
		$disabled{hosts}{$1}{$h} = 1;
	    }

	} elsif ($r =~ /^watch (\S+) service (\S+)$/) {
	    $disabled{services}{$1}{$2} = 1;

	} elsif ($r =~ /^watch (\S+)/) {
	    $disabled{watches}{$1} = 1;

	} else {
	    next;
	}
    }

    return %disabled;
}


sub list_alerthist {
    my $self = shift;
    my ($r, @h, @alerts, $h, $type, $group, $service, $time, $alert, $args, $summary);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @h) = _do_cmd ($self->{HANDLE}, "list alerthist");

    if (!defined $r) {
	$self->{ERROR} = "error (@h)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    foreach $h (@h) {
	   $h =~ /^(\S+) \s+ (\S+) \s+ (\S+) \s+
		   (\d+) \s+ (\S+) \s+ \(([^)]*)\) \s+ (.*)$/x;
       ($type, $group, $service, $time, $alert, $args, $summary) =
       ($1,	$2,	  $3,	 $4,	 $5,	$6   , $7      );
       
       push @alerts, { 'watch' => $group,
		   'service' => $service,
		   'time' => $time,
		   'alert' => $alert,
		   'type'  => $type,
		   'args' => $args,
		   'summary' => $summary };
    }

    return @alerts;
}


sub list_failurehist {
    my $self = shift;
    my ($r, @f, $f, $group, $service, $time, $summary, @failures);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @f) = _do_cmd ($self->{HANDLE}, "list failurehist");

    if (!defined $r) {
	$self->{ERROR} = "@f";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    foreach $f (@f) {
    	($group, $service, $time, $summary) = split (/\s+/, $f, 4);
	push @failures, {
	    	'watch' => $group,
		'service' => $service,
		'time' => $time,
		'summary' => $summary
	    };
    }

    return @failures;
}


sub list_pids {
    my $self = shift;
    my ($r, $l, @pids, @p, $p, $pid, $group, $service, $server);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @p) = _do_cmd ($self->{HANDLE}, "list pids");

    if (!defined $r) {
	$self->{ERROR} = "@p";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    foreach $p (@p) {
    	if ($p =~ /(\d+) server/) {
	    $server = $1;

	} else {
	    ($pid, $group, $service) = split (/\s+/, $p);
	    push @pids, { watch => $group, service => $service, pid => $pid };
	}
    }

    return ($server, @pids);
}


sub list_state {
    my $self = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "list state");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    if ($l =~ /scheduler running/) {
    	return (1, $l);
    } elsif ($l =~ /scheduler stopped since (\d+)/) {
    	return (0, $1);
    }
}


sub start {
    my $self = shift;

    _start_stop ($self, "start");
}


sub stop {
    my $self = shift;

    _start_stop ($self, "stop");
}


sub reset {
    my $self = shift;
    my @opts = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if (@opts == 0) {
	($r, $l) = _do_cmd ($self->{HANDLE}, "reset");
    } else {
	($r, $l) = _do_cmd ($self->{HANDLE}, "reset @opts");
    }

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub reload {
    my $self = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "reload");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub term {
    my $self = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "term");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub set_maxkeep {
    my $self = shift;
    my $val = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($val !~ /^\d+$/) {
    	$self->{ERROR} = "invalid value for maxkeep";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "set maxkeep $val");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}

sub get_maxkeep {
    my $self = shift;
    my ($r, $l, $val);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "set maxkeep");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    $l =~ /maxkeep = (\d+)/;

    return $1;
}


sub test {
    my $self = shift;
    my ($group, $service) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if (!defined $group) {
    	$self->{ERROR} = "group not specified";
	return undef;
    }

    if (!defined $service) {
    	$self->{ERROR} = "service not specified";
	return undef;
    }


    ($r, $l) = _do_cmd ($self->{HANDLE}, "test $group $service");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub ack {
    my $self = shift;
    my ($group, $service, $text) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "ack $group $service $text");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub loadstate {
    my $self = shift;
    my (@state) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "loadstate @state");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub savestate {
    my $self = shift;
    my (@state) = @_;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "savestate @state");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub servertime {
    my $self = shift;
    my ($r, $l, $t);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "servertime");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    $l =~ /^(\d+)/;
    return $1;
}


#
#
#
sub crap_cmd {
    my $self = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "COMMAND");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

}


sub list_aliases {
    my $self = shift;
    my ($r, @d, $d, $group, $service, @allAlias, $aliasBlock, %alias);

    undef $self->{ERROR};

    if ($self->version < 0.38) {
    	$self->{ERROR} = "list aliases not supported";
	return undef;
    }

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @d) = _do_cmd ($self->{HANDLE}, "list aliases");

    if (!defined $r) {
	$self->{ERROR} = "error (@d)";
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r if (!defined $r);

	# the block separator is \n\n
	@allAlias = split (/\n\n/ ,join ("\n", @d));
	foreach $aliasBlock (@allAlias) {
		my(@allServices, $headerAlias, @headerAlias, $nameLine, $name, $description);
		
		# extract the service block
		@allServices = split ( /\nservice\s*/, $aliasBlock);
		# The first element is not a service block, it is the alias header
		# alias FOO
		# FOO is a good service
		# FOO bla bla
		$headerAlias = shift (@allServices);
		# Split the block to get the name and the description
		@headerAlias = split (/\n/, $headerAlias);
		$nameLine = shift(@headerAlias);
		$nameLine =~ /\Aalias\s+(\S+)/;
		$name = $1;
		
		$headerAlias = join("\n", @headerAlias);
		$alias{$name}{'declaration'} = ($headerAlias) ? $headerAlias : '?';
		
		foreach $service (@allServices) {
			my($serviceName, @allWatch, $watch);
			@allWatch = split ("\n", $service);
			$serviceName = shift(@allWatch);
			foreach $watch (@allWatch) {
				my($groupWatched, $serviceWatched, @items, $url);
				if($watch =~ /\Awatch\s+(\S+)\s+service\s+(\S+)\s+items\s*(.*)\Z/){
					$groupWatched   = $1;
					$serviceWatched = $2;
					@items		= split(/\s+/, $3);
					$alias{$name}{'service'}{$serviceName}{'watch'}{$groupWatched}{'service'}{$serviceWatched}{'items'} = [ @items ];
					
				}elsif($watch =~ /\Aurl\s+(.*)\Z/){
					$url = $1;
					$alias{$name}{'service'}{$serviceName}{'url'} = $url;
				}
			}			
		}
		
	}
    return %alias;
}


#------------------------------------------------------------------------------

sub _start_stop {
    my $self = shift;
    my $cmd = shift;
    my ($r, $l);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    if ($cmd ne "start" && $cmd ne "stop") {
    	$self->{ERROR} = "undefined command";
	return undef;
    }

    ($r, $l) = _do_cmd ($self->{HANDLE}, "$cmd");

    if (!defined $r) {
	$self->{ERROR} = $l;
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    return $r;
}


sub _list_opstatus {
    my ($self, $cmd) = @_;
    my ($r, @op, %op, $o, %opstatus);
    my ($group, $service, $last, $timer, $summary);
    my ($w, $var, $val);

    my ($STAT_FAIL, $STAT_OK, $STAT_COLDSTART,
	$STAT_WARMSTART, $STAT_LINKDOWN,
    	$STAT_UNKNOWN, $STAT_TIMEOUT, $STAT_UNTESTED,
	$STAT_DEPEND, $STAT_WARN) = (0..9);

    undef $self->{ERROR};

    if (!$self->{CONNECTED}) {
    	$self->{ERROR} = "not connected";
	return undef;
    }

    ($r, @op) = _do_cmd ($self->{HANDLE}, "$cmd");

    if (!defined $r) {
	$self->{ERROR} = $op[0];
    	return undef;
    } elsif ($r !~ /^220/) {
	$self->{ERROR} = $r;
    	return undef;
    }

    if ($self->version >= 0.38) {
    	foreach $o (@op) {
	    foreach $w (quotewords ('\s+', 0, $o)) {
	    	($var, $val) = split (/=/, $w);
		$op{$var} = $val;
	    }

	    next if ($op{group} eq "");
	    next if ($op{service} eq "");
	    $group = $op{"group"};
	    $service = $op{"service"};
	    foreach $w (keys %op) {
	    	$opstatus{$group}{$service}{$w} = $op{$w};
	    }
	}

    #
    # old protocol, 0.37
    #
    } else {
    	foreach $o (@op) {
	    ($group, $service, $last, $timer, $summary) = split (/\s+/, $o, 5);
	    if ($last == 0) {
		%{$opstatus{$group}{$service}} = (
		    'opstatus' => $STAT_UNTESTED,
		    'last_failure' => undef,
		    'last_success' => undef,
		    'last_trap' => undef,
		    'timer' => $timer,
		    'ack' => undef,
		    'ackcomment' => undef,
		    'last_summary' => "untested",
		    'exitval' => undef,
		    'group' => $group,
		    'service' => $service
		);
	    } elsif ($summary =~ /^succeeded/) {
		$summary =~ s/^succeeded\s+//;
		%{$opstatus{$group}{$service}} = (
		    'opstatus' => $STAT_OK,
		    'last_failure' => undef,
		    'last_success' => $last,
		    'last_trap' => undef,
		    'timer' => $timer,
		    'ack' => undef,
		    'ackcomment' => undef,
		    'last_summary' => $summary,
		    'exitval' => 0,
		    'group' => $group,
		    'service' => $service
		);
	    } elsif ($summary =~ /^failed/) {
		$summary =~ s/^failed\s+//;
		%{$opstatus{$group}{$service}} = (
		    'opstatus' => $STAT_FAIL,
		    'last_failure' => $last,
		    'last_success' => undef,
		    'last_trap' => undef,
		    'timer' => $timer,
		    'ack' => undef,
		    'ackcomment' => undef,
		    'last_summary' => $summary,
		    'exitval' => 1,
		    'group' => $group,
		    'service' => $service
		);
	    }
	}
    }

    return %opstatus;
}


sub _sock_write {
    my ($sock, $buf) = @_;
    my ($nleft, $nwritten);

    $nleft = length ($buf);
    while ($nleft) {
        $nwritten = syswrite ($sock, $buf, $nleft);
        return undef if (!defined ($nwritten));
        $nleft -= $nwritten;
        substr ($buf, 0, $nwritten) = "";
    }
}


sub _do_cmd {
    my ($fd, $cmd) = @_;
    my ($l, $r, @out);

    @out = ();
    return (undef, undef) if (!defined _sock_write ($fd, "$cmd\n"));

        for (;;) {
            ($r, $l) = _sock_readline ($fd);
            return (undef, $l) if (!defined $r);
            return (undef, "EOF") if ($r eq "eof");

            if ($l =~ /^(\d{3}\s)/) {
                last;
            }
            push (@out, $l);
        }

        ($l, @out);
}


sub _sock_readline {
    my ($sock) = @_;
    my ($ch, $buf, $r);

    $buf = "";

    while ($r = sysread ($sock, $ch, 1)) {
        last if ($ch eq "\n");
        $buf .= $ch;
    }

    if (!defined $r) {
        return (undef, $buf);
    }

    if ($r == 0) {
        return ("eof", $buf);
    }
    (1, $buf);
}

1;

#
# not yet implemented
#
#set group service var value
#get group service var
#list aliasgroups
