# MonArch - Groundwork Monitor Architect
# MonarchFoundationSync.pm
#
############################################################################
# Release 4.0
# October 2011
############################################################################
#
# Copyright 2007-2011 GroundWork Open Source, Inc. (GroundWork)
# All rights reserved. This program is free software; you can redistribute
# it and/or modify it under the terms of the GNU General Public License
# version 2 as published by the Free Software Foundation.
#
# 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.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#

use strict;

package FoundationSync;

use IO::Socket;
use Carp;
use Time::HiRes;
use DBI;
use MonarchStorProc;
use MonarchAudit;
use CollageQuery;

my $use_sync_start_action = 1;    # Leave as 1 to get Foundation to flush its internal queues of results already received.
my $use_sync_stop_action  = 0;    # Leave as 0.

my $foundation_msg_count = 0;
my $remote_host          = "127.0.0.1";
my $remote_port          = 4913;
my $logfile              = "/usr/local/groundwork/foundation/container/logs/monarch_foundation_sync.log";
my $maxhostsendcount     = 256;   # a power of 2 makes division faster
my $max_bulk_host_add    = 200;
my $single_obj_timeout   = 0.350; # Estimated max seconds per object deletion or insertion.
my $wait_sleep_seconds   = 3;     # May be set to a fractional value.
my $abort_on_error       = 1;     # If set, abort Commit after first error seen.

# FIX THIS:  set these values as needed for production use
my $show_timeouts        = 1;     # Set to 0 to suppress, 1 to show timeout messages.
my $show_napping         = 1;     # Set to 0 for normal operation, 1 to emit napping messages to Apache error log.
				  # (Set to 1 for now to guarantee Apache does not give up on a long-running commit operation.)

my $logging              = 1;     # Set to 0 to disable debug logging
				  # and to 1 for debug instance logging (a static file is overwritten)
				  # and to 2 for persistent logging (file will grow).
my $log_as_utf8          = 0;     # Set to 0 to log Foundation messages as ISO-8859-1, to 1 to log as UTF-8.

my $debug                = 0;
my $debug_waits          = $debug >= 1;

my $errorstring          = undef;
my $socket               = undef;
my $collage_dbh          = undef;
my $change_time          = undef;

# FIX THIS:  RaiseError, PrintError?  what about the same in the event feeder?
sub collage_connect {
    my ( $dbname, $dbhost, $dbuser, $dbpass, $dbtype ) = CollageQuery::readGroundworkDBConfig('collage');
    my $dsn = '';
    if ( defined($dbtype) && $dbtype eq 'postgresql' ) {
	$dsn = "DBI:Pg:dbname=$dbname;host=$dbhost";
    }
    else {
	$dsn = "DBI:mysql:database=$dbname;host=$dbhost";
    }
    $collage_dbh = DBI->connect( $dsn, $dbuser, $dbpass, { 'AutoCommit' => 1, 'RaiseError' => 1 } )
      or return "Can't connect to database $dbname. Error:" . $DBI::errstr;
    return '';
}

sub collage_disconnect {
    $collage_dbh->disconnect();
}

sub count_objects_statement {
    my $obj_type = $_[0];

    if ($obj_type eq 'hosts') {
	return "select count(*) from ApplicationType at, Host h where at.Name = 'NAGIOS' and h.ApplicationTypeID = at.ApplicationTypeID";
    }
    elsif ($obj_type eq 'services') {
	return "select count(*) from ApplicationType at, ServiceStatus ss where at.Name = 'NAGIOS' and ss.ApplicationTypeID = at.ApplicationTypeID";
    }
    elsif ($obj_type eq 'hostgroups') {
	# Someday, when we count hostgroups in MonarchAudit using a CollageQuery query that qualifies
	# by ApplicationType being NAGIOS, we will want to use this more complex query here.
	# return "select count(*) from ApplicationType at, HostGroup hg where at.Name = 'NAGIOS' and hg.ApplicationTypeID = at.ApplicationTypeID";
	return "select count(*) from HostGroup";
    }
    elsif ($obj_type eq 'hostgroup members') {
	# Someday, when we count hostgroups and hostgroup members in MonarchAudit using CollageQuery
	# queries that qualify by ApplicationType being NAGIOS, we will want to use a more complex
	# query here, similar to the following except that it should also match the hostgroup to the
	# ApplicationType NAGIOS, not just the individual hosts.
	# return "select count(*) from ApplicationType at, Host h, HostGroupCollection hgc where at.Name = 'NAGIOS' and h.ApplicationTypeID = at.ApplicationTypeID and hgc.HostID = h.HostID";
	return "select count(*) from HostGroupCollection";
    }
    elsif ($obj_type eq 'servicegroups') {
	# Someday, when we count servicegroups in MonarchAudit using a CollageQuery query that
	# qualifies by ApplicationType being NAGIOS, we will want to use a more complex query
	# here that also imposes such a qualification.
	return "select count(*) from Category c, EntityType et where et.Name = 'SERVICE_GROUP' and c.EntityTypeID = et.EntityTypeID";
    }
    elsif ($obj_type eq 'servicegroup members') {
	# Someday, when we count servicegroups and servicegroup members in MonarchAudit using
	# CollageQuery queries that qualify by ApplicationType being NAGIOS, we will want to
	# use a more complex query here that also imposes such qualifications.
	return
	    "select count(*)
	    from   ServiceStatus ss, CategoryEntity ce, Category c, EntityType et
	    where  et.Name = 'SERVICE_GROUP'
	    and    c.EntityTypeID = et.EntityTypeID
	    and    ce.CategoryID = c.CategoryID
	    and    ss.ServiceStatusID = ce.ObjectID";
    }
    else {
	return undef;
    }
}

sub wait_for_foundation {
    # my $self    = $_[0];
    my $change    = $_[1];
    my $obj_type  = $_[2];
    my $obj_delta = $_[3];
    my $obj_count = $_[4];
    my $starttime = Time::HiRes::time();
    my $timeout   = $obj_delta * $single_obj_timeout;  # Seconds to wait before issuing a warning.
    my @warnings  = ();
    my @errors    = ();
    my $now;
    my $timeleft;

    # FIX THIS:  This is just a temporary override, to guarantee we won't run into timeouts during development,
    # until we all have the things that might time out optimized so they shouldn't ever.
    # $timeout = 900;

    print STDERR "=== Waiting for $change of $obj_delta $obj_type, to end up with $obj_count.\n" if $debug_waits;

    # FIX THIS?
    # return \@errors if ($obj_delta == 0);

    my $sqlstmt = count_objects_statement($obj_type);
    if (!$sqlstmt) {
	push @errors, "Error:  bad object type '$obj_type'";
    }
    else {
	my $count;
	my $prev_count = -1;
	my $napped     = 0;
	for (;;) {
	    last if $main::shutdown_requested;
	    $count = $collage_dbh->selectrow_array($sqlstmt);
	    if ( !defined($count) ) {
		print STDERR  "Error:  cannot count $obj_type: ", $collage_dbh->errstr, "\n";
		push @errors, "Error:  cannot count $obj_type: ", $collage_dbh->errstr;
		$napped = 0;
		last;
	    }
	    last if ($count == $obj_count);
	    if ($prev_count >= 0 &&
		( ( $change eq 'add' && $count < $prev_count ) || ( ( $change eq 'delete' || $change eq 'clear' ) && $count > $prev_count ) )
	      )
	    {
		# FIX LATER:  when we get back to aborting when timeouts occur, this should be an error, not a warning
		print STDERR "Warning:  In $change of $obj_delta $obj_type, object count is "
		  . ($change eq 'add' ? 'decreasing' : 'increasing') . " (now have $count).\n";
		push @warnings, "Warning:  Count of $obj_type is going in the wrong direction for $change.";
		last;
	    }
	    $prev_count = $count;

	    # To accommodate very small changes without spurious errors, we don't
	    # enforce a timeout until we have waited at least one napping cycle.
	    $now = Time::HiRes::time();
	    if ( $napped && ($now - $starttime) > $timeout ) {
		if ( $show_timeouts ) {
		    push @warnings, "Notice:  Expecting $obj_count, have $count $obj_type;";
		    push @warnings, "$change of $obj_delta $obj_type is taking more than estimated $timeout seconds.";
		}
		# FIX THIS:  someday, when we no longer warn but only issue errors on timeouts, we can put these lines back.
		# print STDERR ">>> Have $count $obj_type; Foundation is taking too long; Commit will be aborted!\n" if ($show_napping || $debug_waits);
		# push @errors, "Error:  Foundation is taking too long to process changes; Commit has been aborted!";
		print STDERR ">>> Have $count $obj_type; Foundation is taking too long; Commit will continue without a full wait.\n" if ($show_napping || $debug_waits);
		push @warnings, "Warning:  Foundation is taking too long to process changes; Commit will continue without a full wait.";
		last;
	    }
	    $timeleft = $starttime + $timeout - $now;
	    $timeleft = 0 if $timeleft < 0;
	    $timeleft = sprintf('%0.3f', $timeleft);
	    print STDERR "napping for $change of $obj_delta $obj_type; want $obj_count, have $count so far; $timeleft secs left\n" if $show_napping;
	    select undef, undef, undef, $wait_sleep_seconds;
	    $napped = 1;
	}
	if ($napped && $show_napping && $count == $obj_count) {
	    $now = Time::HiRes::time();
	    my $waittime = $now - $starttime;
	    $waittime = sprintf('%0.3f', $waittime);
	    print STDERR "napping for $change of $obj_delta $obj_type is over; waiting took $waittime secs\n";
	}
    }

    return \@warnings, \@errors;
}

# sync() - Synchronize the monarch and foundation databases for a single Monarch group
#
sub sync_group {
    # my $self = $_[0];
    my $group = $_[1];

    sync('',{'group'=>$group});
}

# sync() - Synchronize the monarch and foundation databases.

# This comment is old and now merely suggestive.
# Stop event broker (actually, all of nagios, including the event feeder, outside of this routine).
# Call Audit->foundation_sync() to build data structure containing
#     delta between previous state and current state, based on
#     difference between monarch and foundation databases.
# Preserve current state of modified objects with calls to CollageQuery methods.  (???)
# Prepare commands in XML format for consumption by Foundation, and
#     send them to a socket on which Foundation is listening.
# Restart event broker (all of nagios, including the event feeder, outside of this routine).

sub sync($$) {
    # my $self   = $_[0];
    my $arg_ref  = $_[1];
    my @warnings = ();
    my @errors   = ();
    my @timing   = ();
    my $warn_ref = undef;
    my $err_ref  = undef;
    my $time_ref = undef;
    my %delta    = ();
    my $phasetime;

    StorProc->start_timing( \$phasetime );

    # FIX MINOR:  it would probably be more efficient to pass back a hashref, rather than copy the whole big %delta structure
    if (defined($arg_ref) && defined($arg_ref->{'group'})) {
	($err_ref, $time_ref, %delta) = Audit->foundation_sync_group($arg_ref->{'group'});
    }
    else {
	($err_ref, $time_ref, %delta) = Audit->foundation_sync();
    }
    push @errors, @$err_ref;
    push @timing, @$time_ref;

    StorProc->capture_timing( \@timing, \$phasetime, 'running Audit' );

    if (@errors) {
	$errorstring = join( '<br>', @errors );
	return \@timing, $errorstring;
    }

    # snapshot from monarch -- check this before auto-vivification below changes the picture
    unless ($delta{'add'} || $delta{'delete'} || $delta{'alter'}) {
	return \@timing, "Synchronization with Foundation completed successfully. No changes were needed.";
    }

    my $deleted_hosts         = scalar keys %{ $delta{'delete'}{'host'} };
    my $deleted_hostgroups    = scalar keys %{ $delta{'delete'}{'hostgroup'} };
    my $deleted_services      = 0;
    my $deleted_servicegroups = scalar keys %{ $delta{'delete'}{'servicegroup'} };

    foreach my $host (keys %{ $delta{'delete'}{'service'} }) {
	$deleted_services += scalar keys %{ $delta{'delete'}{'service'}{$host} };
    }

    # We need to count as well the objects that are not individually deleted but will be automatically
    # cascade-deleted when containing objects are deleted, so the final counts we wait for will be correct.
    my $cascade_deleted_services             = $delta{'statistics'}{'cascade_deleted_services'};
    my $cascade_deleted_hostgroup_members    = $delta{'statistics'}{'cascade_deleted_hostgroup_members'};
    my $cascade_deleted_servicegroup_members = $delta{'statistics'}{'cascade_deleted_servicegroup_members'};

    my $added_hosts           = scalar keys %{ $delta{'add'}{'host'} };
    my $added_hostgroups      = scalar keys %{ $delta{'add'}{'hostgroup'} };
    my $added_services        = 0;
    my $added_servicegroups   = scalar keys %{ $delta{'add'}{'servicegroup'} };

    foreach my $host (keys %{ $delta{'add'}{'service'} }) {
	$added_services += scalar keys %{ $delta{'add'}{'service'}{$host} };
    }

    # FIX THIS:  calculate the proper values to assign here, and do so (I believe this is correct, but do some testing)
    my $cleared_hostgroup_members    = $delta{'statistics'}{'cleared_hostgroup_members'};
    my $cleared_servicegroup_members = $delta{'statistics'}{'cleared_servicegroup_members'};

    my $status = collage_connect();
    # FIX THIS
    push @errors, $status       if $status;
    print STDERR  $status, "\n" if $status;

    if (@errors) {
	$errorstring = join( '<br>', @errors );
	return \@timing, $errorstring;
    }

    # Initial numbers of objects in Foundation, to which deletes and adds will be applied.
    # FIX THIS:  should these numbers be derived from these hashes instead?
    # %delta{'exists'}{'hostgroup'}
    # %delta{'exists'}{'service'}
    # %delta{'exists'}{'host'}
    # %delta{'exists'}{}         # maybe 'servicegroup' ?  need to prove it first
    my $initial_host_count                = $collage_dbh->selectrow_array( count_objects_statement('hosts') );
    my $initial_hostgroup_count           = $collage_dbh->selectrow_array( count_objects_statement('hostgroups') );
    my $initial_service_count             = $collage_dbh->selectrow_array( count_objects_statement('services') );
    my $initial_servicegroup_count        = $collage_dbh->selectrow_array( count_objects_statement('servicegroups') );
    my $initial_hostgroup_member_count    = $collage_dbh->selectrow_array( count_objects_statement('hostgroup members') );
    my $initial_servicegroup_member_count = $collage_dbh->selectrow_array( count_objects_statement('servicegroup members') );

    # The $low_service_count value here corresponds to after deleting individual services but not yet
    # taking account of additional services that will be cascade-deleted when deleting entire hosts.
    my $low_host_count         = $initial_host_count         - $deleted_hosts;
    my $low_hostgroup_count    = $initial_hostgroup_count    - $deleted_hostgroups;
    my $low_service_count      = $initial_service_count      - $deleted_services;
    my $low_servicegroup_count = $initial_servicegroup_count - $deleted_servicegroups;

    # The $high_service_count value here must take into account all services that were cascade-deleted.
    my $high_host_count         = $low_host_count         + $added_hosts;
    my $high_hostgroup_count    = $low_hostgroup_count    + $added_hostgroups;
    my $high_service_count      = $low_service_count      - $cascade_deleted_services + $added_services;
    my $high_servicegroup_count = $low_servicegroup_count + $added_servicegroups;

    # FIX THIS
    my $low_hostgroup_member_count    = $initial_hostgroup_member_count    - $cascade_deleted_hostgroup_members    - $cleared_hostgroup_members;
    my $low_servicegroup_member_count = $initial_servicegroup_member_count - $cascade_deleted_servicegroup_members - $cleared_servicegroup_members;

    my $logfh;
    if ($logging == 1) {
	open( $logfh, '>', $logfile) && $logfh->autoflush(1);
	$errorstring = "$!: $logfile Foundation sync is in debug mode but cannot write to log." if $! =~ /permission denied/i;
    }
    elsif ($logging == 2) {
	open( $logfh, '>>', $logfile) && $logfh->autoflush(1);
	$errorstring = "$!: $logfile Foundation sync is in debug mode but cannot append to log." if $! =~ /permission denied/i;
    }
    # Connection
    my $max_connect_attempts = 3;
    unless ($errorstring) {
	my $status;
	for (my $i = 0; $i <= $max_connect_attempts; $i++) {
	    if ($i == $max_connect_attempts) {
		print $logfh "Couldn't connect to $remote_host:$remote_port : $status\n" if $logging;
		$errorstring = "<h7>Error:  Unable to connect to Collage database (check gwservices).</h7>\n";
	    } else {
		$socket = IO::Socket::INET->new( PeerAddr => $remote_host, PeerPort => $remote_port, Proto => "tcp", Type => SOCK_STREAM );
		if ($socket) {
		    # FIX THIS:  this is perhaps also something we want to send to $socket;
		    # there's no point in logging it here unless we do so
		    # print $logfh "<GENERICLOG consolidation='SYSTEM' ApplicationType='SYSTEM' MonitorServerName='localhost' Device='$remote_host' Severity='OK' MonitorStatus='OK' TextMessage='Foundation-Monarch synch process completed. It might take up to 30 sec. for changes to show up in the status pages.' />\n" if $logging;
		    # Ensure that we push out all the data we write, before
		    # we go waiting for Foundation to finish processing it.
		    $socket->autoflush(1);
		    last;
		} else {
		    $status = $!;
		    sleep 1;
		}
	    }
	}
    }

    if ($logging) {
	printf $logfh "hosts:                %5d - %5d = %5d; + %5d = %5d\n",
	    $initial_host_count, $deleted_hosts, $low_host_count, $added_hosts, $high_host_count;
	printf $logfh "hostgroups:           %5d - %5d = %5d; + %5d = %5d\n",
	    $initial_hostgroup_count, $deleted_hostgroups, $low_hostgroup_count, $added_hostgroups, $high_hostgroup_count;
	printf $logfh "services:             %5d - %5d = %5d; - %5d + %5d = %5d\n",
	    $initial_service_count, $deleted_services, $low_service_count, $cascade_deleted_services, $added_services, $high_service_count;
	printf $logfh "servicegroups:        %5d - %5d = %5d; + %5d = %5d\n",
	    $initial_servicegroup_count, $deleted_servicegroups, $low_servicegroup_count, $added_servicegroups, $high_servicegroup_count;
	printf $logfh "hostgroup members:    %5d - %5d - %5d = %5d; + ????? = ?????\n",
	    $initial_hostgroup_member_count, $cascade_deleted_hostgroup_members, $cleared_hostgroup_members, $low_hostgroup_member_count;
	printf $logfh "servicegroup members: %5d - %5d - %5d = %5d; + ????? = ?????\n",
	    $initial_servicegroup_member_count, $cascade_deleted_servicegroup_members, $cleared_servicegroup_members, $low_servicegroup_member_count;
    }

    StorProc->capture_timing( \@timing, \$phasetime, 'data preparation and Foundation connection' );

    if ($socket) {
	my $xml_out = '';

	## print $logfh "Begin process ...\n" if $logging;

	if ($use_sync_start_action) {
	    $xml_out = "<SYNC action='start'/>\n";
	    print $socket $xml_out;
	    print $logfh $xml_out if $logging;
	    $xml_out = '';
	}

	# push all changes to Foundation, in measured stages

	# We only call this once, because we expect that time formatting is an expensive operation when done
	# repeatedly, and we don't need any finer resolution than the moment at which the entire sync is run.
	$change_time = get_last_state_change();

	# As a general rule, we need to to wait for deletions to finish before starting the corresponding
	# additions, bacause we cannot tell if the additions are truly done unless we are truly sure that
	# all the deletions are also done.  (Otherwise, we might still have some offsetting delete/add
	# pairs still outstanding, leading to a matching count when the work is not yet done.)

	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    delete_services( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'delete', 'services', $deleted_services, $low_service_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "delete of $deleted_services services" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    delete_hosts( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'delete', 'hosts', $deleted_hosts, $low_host_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "delete of $deleted_hosts hosts" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    add_hosts( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'add', 'hosts', $added_hosts, $high_host_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "add of $added_hosts hosts" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    add_services( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'add', 'services', $added_services, $high_service_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "add of $added_services services" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    delete_hostgroups   ( \%delta, $socket, $logfh );
	    delete_servicegroups( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'delete', 'hostgroups', $deleted_hostgroups, $low_hostgroup_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "delete of $deleted_hostgroups hostgroups" );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'delete', 'servicegroups', $deleted_servicegroups, $low_servicegroup_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "delete of $deleted_servicegroups servicegroups" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    add_hostgroups   ( \%delta, $socket, $logfh );
	    add_servicegroups( \%delta, $socket, $logfh );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'add', 'hostgroups', $added_hostgroups, $high_hostgroup_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "add of $added_hostgroups hostgroups" );
	    ($warn_ref, $err_ref) = wait_for_foundation( '', 'add', 'servicegroups', $added_servicegroups, $high_servicegroup_count );
	    push @warnings, @$warn_ref;
	    push @errors, @$err_ref;
	    StorProc->capture_timing( \@timing, \$phasetime, "add of $added_servicegroups servicegroups" );
	}
	unless ($main::shutdown_requested || (@errors && $abort_on_error)) {
	    add_hostgroup_members   ( \%delta, $socket, $logfh );
	    add_servicegroup_members( \%delta, $socket, $logfh );
	    update_hostgroups       ( \%delta, $socket, $logfh );
	    update_servicegroups    ( \%delta, $socket, $logfh );
	    update_hosts            ( \%delta, $socket, $logfh );
	    update_services         ( \%delta, $socket, $logfh );
	}

	if ($use_sync_stop_action) {
	    $xml_out = "<SYNC action='stop'/>\n";
	}
	$xml_out .= "<GENERICLOG consolidation='SYSTEM' ApplicationType='SYSTEM' MonitorServerName='localhost' Device='$remote_host' Severity='OK' MonitorStatus='OK' TextMessage='Foundation-Monarch synch process completed. It might take up to 30 sec. for changes to show up in the status pages.' />\n";
	print $socket $xml_out;
	print $logfh  $xml_out if $logging;
	$xml_out = '<SERVICE-MAINTENANCE command="close" />';
	print $socket $xml_out;
	print $logfh "$xml_out\n\n" if $logging;

	close $socket;
    }
    collage_disconnect();
    close $logfh if $logging;

    StorProc->capture_timing( \@timing, \$phasetime, "sending of final hostgroup, servicegroup, host, and service changes" );

    if ($main::shutdown_requested) {
	push @errors, 'Error:  Processing was interrupted.';
    }

    if (@errors) {
	# FIX THIS:  I'd like a cleaner way to hand back all the error strings.
	# Also, the warnings and errors won't necessarily appear here interleaved in the order they originally occurred.
	$errorstring = join( '<br>', @warnings, @errors );
	return \@timing, $errorstring;
    } else {
	$errorstring = join( '<br>', @warnings, "Synchronization with Foundation completed successfully. Changes were required." );
	return \@timing, $errorstring;
    }
}

sub delete_hosts {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    foreach my $host (keys %{ $delta->{'delete'}{'host'} }) {
	push @xmlstring, "\t<Host Host='".$host."' />\n";
	if (++$cnt == $max_bulk_host_add) {
	    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) ) if (@xmlstring);
}

sub delete_services {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    foreach my $host (keys %{ $delta->{'delete'}{'service'} }) {
	foreach my $service (keys %{ $delta->{'delete'}{'service'}{$host} }) {
	    push @xmlstring, "\t<Service Host='".$host."' ServiceDescription='".$service."' />\n";
	    if (++$cnt == $max_bulk_host_add) {
		write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) );
		@xmlstring = ();
		$cnt = 0;
	    }
	}
    }
    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) ) if (@xmlstring);
}

sub add_hosts {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $alias;
    my $notes;
    foreach my $host (keys %{ $delta->{'add'}{'host'} }) {
	$alias = $delta->{'add'}{'host'}{$host}{'alias'};
	$notes = $delta->{'add'}{'host'}{$host}{'notes'};

	# FIX LATER:  Is the existence of an alias guaranteed here?  Yes, supposedly.
	$alias =~ s/\n/ /g;
	$alias =~ s/<br>/ /ig;
	$alias =~ s/&/&amp;/g;
	$alias =~ s/"/&quot;/g;
	$alias =~ s/'/&apos;/g;
	$alias =~ s/</&lt;/g;
	$alias =~ s/>/&gt;/g;

	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	}

	push @xmlstring,
	    "\t<Host Host='",      $host,
	    "' Description='",     $host,
	    ((defined($notes) && $notes ne '') ? ("' Notes='" . $notes) : ''),
	    "' Device='",          $delta->{'add'}{'host'}{$host}{'address'},
	    "' DisplayName='",     $host,
	    "' LastStateChange='", $change_time,
	    "' Parent='",          $delta->{'add'}{'host'}{$host}{'parents'},
	    "' Alias='",           $alias,
	    "' />\n";

	if (++$cnt == $max_bulk_host_add) {
	    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) ) if (@xmlstring);
}

# Add new services
sub add_services {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $notes;
    foreach my $host (keys %{ $delta->{'add'}{'service'} }) {
	foreach my $service (keys %{ $delta->{'add'}{'service'}{$host} }) {
	    $notes = $delta->{'add'}{'servicenotes'}{$host}{$service};

	    if (defined $notes) {
		$notes =~ s/&/&amp;/g;
		$notes =~ s/"/&quot;/g;
		$notes =~ s/'/&apos;/g;
		$notes =~ s/</&lt;/g;
		$notes =~ s/>/&gt;/g;
	    }

	    push @xmlstring,
		"\t<Service Host='", $host,
		"' ServiceDescription='", $service,
		((defined($notes) && $notes ne '') ? ("' Notes='" . $notes) : ''),
		"' CheckType='ACTIVE' StateType='SOFT' MonitorStatus='PENDING' LastHardState='PENDING' LastStateChange='",
		$change_time, "' />\n";
	    if (++$cnt == $max_bulk_host_add)  {
		write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) );
		@xmlstring = ();
		$cnt = 0;
	    }
	}
    }
    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) ) if (@xmlstring);
}

sub update_hosts {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $alias;
    my $address;
    my $notes;
    my $parents;
    foreach my $host (keys %{ $delta->{'alter'}{'host'} }) {
	$alias   = $delta->{'alter'}{'host'}{$host}{'alias'};
	$address = $delta->{'alter'}{'host'}{$host}{'address'};
	$notes   = $delta->{'alter'}{'host'}{$host}{'notes'};
	$parents = $delta->{'alter'}{'host'}{$host}{'parents'};
	push @xmlstring, "\t<Host Host='", $host, "' Description='", $host, "'";
	if (defined $alias) {
	    $alias =~ s/\n/ /g;
	    $alias =~ s/<br>/ /ig;
	    $alias =~ s/&/&amp;/g;
	    $alias =~ s/"/&quot;/g;
	    $alias =~ s/'/&apos;/g;
	    $alias =~ s/</&lt;/g;
	    $alias =~ s/>/&gt;/g;
	    push @xmlstring, " Alias='", $alias, "'";
	}
	if (defined $address) {
	    push @xmlstring, " Device='", $address , "'";
	}
	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	    push @xmlstring, " Notes='", $notes, "'";
	}
	if (defined $parents) {
	    push @xmlstring, " Parent='", $parents, "'";
	}
	push @xmlstring, " />\n";
	if (++$cnt == $max_bulk_host_add) {
	    write_command_xml( $socket, $logfh, "MODIFY", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "MODIFY", join( '', @xmlstring ) ) if (@xmlstring);
}

# Change existing service properties
sub update_services {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $notes;
    foreach my $host (keys %{ $delta->{'alter'}{'service'} }) {
	foreach my $service (keys %{ $delta->{'alter'}{'service'}{$host} }) {
	    # No {'notes'} appended, for now.  See the audit routine for this construction.
	    $notes = $delta->{'alter'}{'service'}{$host}{$service};

	    if (defined $notes) {
		$notes =~ s/&/&amp;/g;
		$notes =~ s/"/&quot;/g;
		$notes =~ s/'/&apos;/g;
		$notes =~ s/</&lt;/g;
		$notes =~ s/>/&gt;/g;
	    }

	    push @xmlstring,
		"\t<Service Host='", $host,
		"' ServiceDescription='", $service,
		((defined($notes) && $notes ne '') ? ("' Notes='" . $notes) : ''),
		"' />\n";
	    if (++$cnt == $max_bulk_host_add)  {
		write_command_xml( $socket, $logfh, "MODIFY", join( '', @xmlstring ) );
		@xmlstring = ();
		$cnt = 0;
	    }
	}
    }
    write_command_xml( $socket, $logfh, "MODIFY", join( '', @xmlstring ) ) if (@xmlstring);
}

sub delete_hostgroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    foreach my $hostgroup (keys %{ $delta->{'delete'}{'hostgroup'} }) {
	push @xmlstring, "\t<HostGroup HostGroup='$hostgroup' />\n";
	if (++$cnt == $max_bulk_host_add)  {
	    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) ) if (@xmlstring)
}

sub delete_servicegroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    foreach my $servicegroup (keys %{ $delta->{'delete'}{'servicegroup'} }) {
	push @xmlstring, "\t<ServiceGroup ServiceGroup='$servicegroup' />\n";
	if (++$cnt == $max_bulk_host_add)  {
	    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "REMOVE", join( '', @xmlstring ) ) if (@xmlstring);
}

sub add_hostgroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $alias;
    my $notes;
    foreach my $hostgroup (keys %{ $delta->{'add'}{'hostgroup'} }) {
	## build host group in chunks
	$alias = $delta->{'add'}{'hostgroup'}{$hostgroup}{'alias'};
	$notes = $delta->{'add'}{'hostgroup'}{$hostgroup}{'notes'};

	if (defined $alias) {
	    $alias =~ s/\n/ /g;
	    $alias =~ s/<br>/ /ig;
	    $alias =~ s/&/&amp;/g;
	    $alias =~ s/"/&quot;/g;
	    $alias =~ s/'/&apos;/g;
	    $alias =~ s/</&lt;/g;
	    $alias =~ s/>/&gt;/g;
	}
	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	}

	push @xmlstring,
	    "\t<HostGroup HostGroup='", $hostgroup,
	    ((defined($alias) && $alias ne '') ? ("' Alias='" . $alias) : ''),
	    ((defined($notes) && $notes ne '') ? ("' Description='" . $notes) : ''),
	    "' />\n";
	if (++$cnt == $max_bulk_host_add)  {
	    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) ) if (@xmlstring);
}

sub add_servicegroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    my $cnt       = 0;
    my @xmlstring = ();
    my $notes;
    foreach my $servicegroup (keys %{ $delta->{'add'}{'servicegroup'} }) {
	## build service group in chunks
	$notes = $delta->{'add'}{'servicegroup'}{$servicegroup}{'notes'};

	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	}

	push @xmlstring,
	    "\t<ServiceGroup ServiceGroup='", $servicegroup,
	    ((defined($notes) && $notes ne '') ? ("' Description='" . $notes) : ''),
	    "' />\n";
	if (++$cnt == $max_bulk_host_add)  {
	    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) );
	    @xmlstring = ();
	    $cnt = 0;
	}
    }
    write_command_xml( $socket, $logfh, "ADD", join( '', @xmlstring ) ) if (@xmlstring);
}

# FIX LATER:  bundle the socket writes here
sub add_hostgroup_members {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    foreach my $hostgroup (keys %{ $delta->{'add'}{'hostgroup'} }) {
	my $total_keys = keys %{ $delta->{'add'}{'hostgroup'}{$hostgroup}{'members'} };
	my $key_index  = 0;
	my @members    = ();
	foreach my $host (keys %{ $delta->{'add'}{'hostgroup'}{$hostgroup}{'members'} }) {
	    push @members, "\t\t<Host Host='".$host."' />\n";
	    if (++$key_index == $total_keys || ($key_index % $maxhostsendcount) == 0) {
		my $xmlstring = join( '', "\t<HostGroup HostGroup='$hostgroup' >\n", @members, "\t</HostGroup>\n" );
		write_command_xml( $socket, $logfh, "MODIFY", $xmlstring );
		@members = ();
	    }
	}
    }
}

# FIX LATER:  bundle the socket writes here
sub add_servicegroup_members {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    foreach my $servicegroup (keys %{ $delta->{'add'}{'servicegroup'} }) {
	# Find the total number of host+services in this group
	my $total_keys = 0;
	foreach my $host (keys %{ $delta->{'add'}{'servicegroup'}{$servicegroup}{'members'} }) {
	    $total_keys += scalar keys %{ $delta->{'add'}{'servicegroup'}{$servicegroup}{'members'}{$host} };
	}
	my $key_index = 0;
	my @members   = ();
	foreach my $host (keys %{ $delta->{'add'}{'servicegroup'}{$servicegroup}{'members'} }) {
	    foreach my $service (keys %{ $delta->{'add'}{'servicegroup'}{$servicegroup}{'members'}{$host} }) {
		push @members, "\t\t<Service Host='".$host."' ServiceDescription='".$service."' />\n";
		if (++$key_index == $total_keys || ($key_index % $maxhostsendcount) == 0) {
		    my $xmlstring = join( '', "\t<ServiceGroup ServiceGroup='$servicegroup' >\n", @members, "\t</ServiceGroup>\n" );
		    write_command_xml( $socket, $logfh, "MODIFY", $xmlstring );
		    @members = ();
		}
	    }
	}
    }
}

# FIX LATER:  perhaps bundle the socket writes here
sub update_hostgroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    ## rebuild host groups in chunks
    foreach my $hostgroup (keys %{ $delta->{'alter'}{'hostgroup'} }) {
	my $alias = $delta->{'alter'}{'hostgroup'}{$hostgroup}{'alias'};
	my $notes = $delta->{'alter'}{'hostgroup'}{$hostgroup}{'notes'};
	if (defined $alias) {
	    $alias =~ s/\n/ /g;
	    $alias =~ s/<br>/ /ig;
	    $alias =~ s/&/&amp;/g;
	    $alias =~ s/"/&quot;/g;
	    $alias =~ s/'/&apos;/g;
	    $alias =~ s/</&lt;/g;
	    $alias =~ s/>/&gt;/g;
	}
	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	}
	my @xmlstring = ();
	if (exists $delta->{'alter'}{'hostgroup'}{$hostgroup}{'members'}) {
	    # CLEAR must be bundled in the same <Adapter> packet with MODIFY
	    # of membership for a given hostgroup, to ensure serialization.
	    my $xmlstring = "\t<HostGroup HostGroup='$hostgroup' />\n";
	    push @xmlstring, "    <Command Action='CLEAR' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
	    my $total_keys = keys %{ $delta->{'alter'}{'hostgroup'}{$hostgroup}{'members'} };
	    my $key_index  = 0;
	    my @members    = ();
	    foreach my $host (keys %{ $delta->{'alter'}{'hostgroup'}{$hostgroup}{'members'} }) {
		push @members,
		    "\t\t<Host Host='", $host,
		    "' />\n";
		if (++$key_index == $total_keys || ($key_index % $maxhostsendcount) == 0) {
		    my $xmlstring = join( '',
			"\t<HostGroup HostGroup='", $hostgroup,
			((defined($alias) && $alias ne '') ? ("' Alias='" . $alias) : ''),
			((defined($notes) && $notes ne '') ? ("' Description='" . $notes) : ''),
			"' >\n", @members, "\t</HostGroup>\n" );
		    push @xmlstring, "    <Command Action='MODIFY' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
		    $alias = undef;
		    $notes = undef;
		    @members = ();
		}
	    }
	}
	if (defined $alias || defined $notes) {
	    my $xmlstring = join( '',
		"\t<HostGroup HostGroup='", $hostgroup,
		((defined($alias) && $alias ne '') ? ("' Alias='" . $alias) : ''),
		((defined($notes) && $notes ne '') ? ("' Description='" . $notes) : ''),
		"' >\n", "\t</HostGroup>\n" );
	    push @xmlstring, "    <Command Action='MODIFY' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
	}
	write_adapter_xml( $socket, $logfh, join( '', @xmlstring ) ) if @xmlstring;
    }
}

# FIX LATER:  perhaps bundle the socket writes here
sub update_servicegroups {
    my $delta  = $_[0];
    my $socket = $_[1];
    my $logfh  = $_[2];

    # rebuild service groups in chunks
    foreach my $servicegroup (keys %{ $delta->{'alter'}{'servicegroup'} }) {
	my $notes = $delta->{'alter'}{'servicegroup'}{$servicegroup}{'notes'};
	if (defined $notes) {
	    $notes =~ s/&/&amp;/g;
	    $notes =~ s/"/&quot;/g;
	    $notes =~ s/'/&apos;/g;
	    $notes =~ s/</&lt;/g;
	    $notes =~ s/>/&gt;/g;
	}
	my @xmlstring = ();
	if (exists $delta->{'alter'}{'servicegroup'}{$servicegroup}{'members'}) {
	    # CLEAR must be bundled in the same <Adapter> packet with MODIFY
	    # of membership for a given servicegroup, to ensure serialization.
	    my $xmlstring = "\t<ServiceGroup ServiceGroup='$servicegroup' />\n";
	    push @xmlstring, "    <Command Action='CLEAR' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
	    ## Find the total number of host+services
	    my $total_keys = 0;
	    foreach my $host (keys %{ $delta->{'alter'}{'servicegroup'}{$servicegroup}{'members'} }) {
		$total_keys += scalar keys %{ $delta->{'alter'}{'servicegroup'}{$servicegroup}{'members'}{$host} };
	    }
	    my $key_index = 0;
	    my @members   = ();
	    foreach my $host (keys %{ $delta->{'alter'}{'servicegroup'}{$servicegroup}{'members'} }) {
		foreach my $service (keys %{ $delta->{'alter'}{'servicegroup'}{$servicegroup}{'members'}{$host} }) {
		    push @members,
			"\t\t<Service Host='", $host,
			"' ServiceDescription='", $service,
			"' />\n";
		    if (++$key_index == $total_keys || ($key_index % $maxhostsendcount) == 0) {
			my $xmlstring = join( '',
			    "\t<ServiceGroup ServiceGroup='", $servicegroup,
			    ((defined($notes) && $notes ne '') ? ("' Description='" . $notes) : ''),
			    "' >\n", @members, "\t</ServiceGroup>\n" );
			push @xmlstring, "    <Command Action='MODIFY' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
			$notes = undef;
			@members = ();
		    }
		}
	    }
	}
	if (defined $notes) {
	    my $xmlstring = join( '',
		"\t<ServiceGroup ServiceGroup='", $servicegroup,
		"' Description='", $notes,
		"' >\n", "\t</ServiceGroup>\n" );
	    push @xmlstring, "    <Command Action='MODIFY' ApplicationType='NAGIOS'>\n$xmlstring    </Command>\n";
	}
	write_adapter_xml( $socket, $logfh, join( '', @xmlstring ) ) if @xmlstring;
    }
}

sub write_adapter_xml {
    my $socket     = $_[0];
    my $log_fh     = $_[1];
    my $xml_string = $_[2];

    $foundation_msg_count++;
    my $xml_out = "<Adapter Session=\"$foundation_msg_count\" AdapterType=\"SystemAdmin\">\n$xml_string</Adapter>\n";
    print $log_fh $xml_out if $logging && !$log_as_utf8;
    utf8::encode($xml_out);
    print $socket $xml_out;
    print $log_fh $xml_out if $logging && $log_as_utf8;
}

sub write_command_xml {
    my $socket     = $_[0];
    my $log_fh     = $_[1];
    my $action     = $_[2];
    my $xml_string = $_[3];

    $foundation_msg_count++;
    my $xml_out = "<Adapter Session=\"$foundation_msg_count\" AdapterType=\"SystemAdmin\">\n    <Command Action='$action' ApplicationType='NAGIOS'>\n$xml_string    </Command>\n</Adapter>\n";
    print $log_fh $xml_out if $logging && !$log_as_utf8;
    utf8::encode($xml_out);
    print $socket $xml_out;
    print $log_fh $xml_out if $logging && $log_as_utf8;
}

sub unindent {
    $_[0] =~ s/^[\n\r]*//;
    my ($indent) = ($_[0] =~ /^([ \t]+)/);
    $_[0] =~ s/^$indent//gm;
}

# Subroutine for getting the current time in SQL Date format
sub get_last_state_change {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec);
}

1;