package Net::Nsca;

use IO::Socket;
use IO::Socket::INET;
use Socket qw ( PF_INET SOCK_STREAM );
use IO::Handle ();
# use Errno qw ( EINPROGRESS EWOULDBLOCK EISCONN ECONNREFUSED );
use Errno qw ( :POSIX );
use Socket;
use Sys::Hostname;

@EXPORT_OK = qw(local_message send_message broadcast_message read_config read_config_hash);

use constant PROGRAM_VERSION => "1.2.0b4-Perl";
use constant MODIFICATION_DATE => "16-03-2006";

use constant OK	=> 0;
use constant ERROR => -1;

use constant TRUE => 1;
use constant FALSE => 0;

use constant STATE_CRITICAL => 	2	; # /* service state return codes */
use constant STATE_WARNING => 	1	;
use constant STATE_OK =>       	0	;
use constant STATE_UNKNOWN =>	3	; # Updated for Nagios.

use constant DEFAULT_SOCKET_TIMEOUT	=> 10	; # /* timeout after 10 seconds */
use constant DEFAULT_SERVER_PORT =>	5667	; # /* default port to use */

use constant MAX_INPUT_BUFFER =>	2048	; # /* max size of most buffers we use */
use constant MAX_HOST_ADDRESS_LENGTH =>	256	; # /* max size of a host address */
use constant MAX_HOSTNAME_LENGTH =>	64	;
use constant MAX_DESCRIPTION_LENGTH =>	128;
use constant MAX_PLUGINOUTPUT_LENGTH =>	512;
use constant MAX_PASSWORD_LENGTH =>     512;

use constant ENCRYPT_NONE =>            0       ; # /* no encryption */
use constant ENCRYPT_XOR =>             1       ; # /* not really encrypted, just obfuscated */
use constant ENCRYPT_DES =>             2       ; # /* DES */
use constant ENCRYPT_3DES =>            3       ; # /* 3DES or Triple DES */
use constant ENCRYPT_CAST128 =>         4       ; # /* CAST-128 */
use constant ENCRYPT_CAST256 =>         5       ; # /* CAST-256 */
use constant ENCRYPT_XTEA =>            6       ; # /* xTEA */
use constant ENCRYPT_3WAY =>            7       ; # /* 3-WAY */
use constant ENCRYPT_BLOWFISH =>        8       ; # /* SKIPJACK */
use constant ENCRYPT_TWOFISH =>         9       ; # /* TWOFISH */
use constant ENCRYPT_LOKI97 =>          10      ; # /* LOKI97 */
use constant ENCRYPT_RC2 =>             11      ; # /* RC2 */
use constant ENCRYPT_ARCFOUR =>         12      ; # /* RC4 */
use constant ENCRYPT_RC6 =>             13      ; # /* RC6 */            ; # /* UNUSED */
use constant ENCRYPT_RIJNDAEL128 =>     14      ; # /* RIJNDAEL-128 */
use constant ENCRYPT_RIJNDAEL192 =>     15      ; # /* RIJNDAEL-192 */
use constant ENCRYPT_RIJNDAEL256 =>     16      ; # /* RIJNDAEL-256 */
use constant ENCRYPT_MARS =>            17      ; # /* MARS */           ; # /* UNUSED */
use constant ENCRYPT_PANAMA =>          18      ; # /* PANAMA */         ; # /* UNUSED */
use constant ENCRYPT_WAKE =>            19      ; # /* WAKE */
use constant ENCRYPT_SERPENT =>         20      ; # /* SERPENT */
use constant ENCRYPT_IDEA =>            21      ; # /* IDEA */           ; # /* UNUSED */
use constant ENCRYPT_ENIGMA =>          22      ; # /* ENIGMA (Unix crypt) */
use constant ENCRYPT_GOST =>            23      ; # /* GOST */
use constant ENCRYPT_SAFER64 =>         24      ; # /* SAFER-sk64 */
use constant ENCRYPT_SAFER128 =>        25      ; # /* SAFER-sk128 */
use constant ENCRYPT_SAFERPLUS =>       26      ; # /* SAFER+ */

use constant TRANSMITTED_IV_SIZE =>     128     ; # /* size of IV to transmit - must be as big as largest IV needed for any crypto algorithm */


use constant NSCA_PACKET_VERSION_3 =>	3		; # /* packet version identifier */
use constant NSCA_PACKET_VERSION_2 =>	2		; # /* packet version identifier */
use constant NSCA_PACKET_VERSION_1 =>	1		; # /* older packet version identifier */

# Work out whether we have the mcrypt libraries on board.
my $HAVE_MCRYPT = 0;
eval {
	require Mcrypt;
	$HAVE_MCRYPT++;
};

# Lookups for loading.
my %mcrypts =	(	ENCRYPT_DES,		"DES",
			ENCRYPT_3DES,		"3DES",
			ENCRYPT_CAST128,  	"CASE128",
			ENCRYPT_CAST256,  	"CASE256",
			ENCRYPT_XTEA,  		"XTEA",
			ENCRYPT_3WAY, 	 	"3WAY",
			ENCRYPT_BLOWFISH,	"BLOWFISH",
			ENCRYPT_TWOFISH,	"TWOFISH",
			ENCRYPT_LOKI97,		"LOKI97",
			ENCRYPT_RC2,		"RC2",
			ENCRYPT_ARCFOUR,	"ARCFOUR",
			ENCRYPT_RC6,		"RC6",
			ENCRYPT_RIJNDAEL128,	"RIJNDAEL128",
			ENCRYPT_RIJNDAEL192,	"RIJNDAEL192",
			ENCRYPT_RIJNDAEL256,	"RIJNDAEL256",
			ENCRYPT_MARS,		"MARS",
			ENCRYPT_PANAMA,		"PANAMA",
			ENCRYPT_WAKE,		"WAKE",
			ENCRYPT_SERPENT,	"SERPENT",
			ENCRYPT_IDEA,		"IDEA",
			ENCRYPT_ENIGMA,		"ENIGMA",
			ENCRYPT_GOST,		"GOST",
			ENCRYPT_SAFER64,	"SAFER64",
			ENCRYPT_SAFER128,	"SAFER128",
			ENCRYPT_SAFERPLUS,	"SAFERPLUS",
		);

=pod

=head1 NAME

Net::Nsca - a perl way to send status checks to NetSaint, locally and remotely

=head1 SYNOPSIS

	Net::Nsca::local_message($message [, $log_file]);
	Net::Nsca::send_message($message, $remote_host [, $config_file [, $remote_port ]]);
	Net::Nsca::broadcast_message( message => $message [, hosts => $hosts ] [, use_config_hosts => bool ] [, config_file => $config_file ] [, remote_port => $remote_port ] [, use_trace => bool ] [, sites => $sites ] [, myhost => hostname ] [, mysite => sitename ] [, send_to_one_in_site => sitename ] );
	($password, $encryption_method) = Net::Nsca::read_config( [ $configfile ]);

=head1 DESCRIPTION

This module provides a simple API to allow perl programs to send checks to the
Nagios server that is monitoring them. This server may be local or remote.
The API has two main methods and one utility method:

=over 4

=item Net::Nsca::local_message($message [, $log_file]);

Pass in a hashref with the message fields in it - the keys are host_name, 
svc_description, return_code, plugin_output -
and optionally the name of the file to append the status check message 
to (the default is /var/nagios/rw/nagios.cmd if you don't supply one)
- Dies if anything goes wrong.

=item Net::Nsca::send_message($message, $remote_host [, $config_file [, $remote_port ]]);

Pass in a hashref with the message fields in it - the keys are host_name, 
svc_description, return_code, plugin_output -
the name or address of the Nagios host, the port number (defaults to 5667), 
and the config file to be read - defaults to /etc/nagios/send_nsca.cfg
- Dies if there's a problem.

=item Net::Nsca::broadcast_message( message => $message [, hosts => $hosts ] [, use_config_hosts => bool ] [, config_file => $config_file ] [, remote_port => $remote_port ] [, use_trace => bool ] [, sites => $sites ] [, myhost => $myhost ] [, myhost => hostname ] [, mysite => sitename ] [, send_to_one_in_site => sitename ] );

Pass in a hashref with the message fields in it as per send_message, and a
%hash of hosts to send the message to.  If 'use_trace' is set to one, the 
plugin_output text in the $message is scanned for hosts or sites that this 
$message has already been sent to, and the $message is not sent to those 
sites in order to avoid excessive traffic.  Read the 'PATH TRACING' section
for further details.

An optional %hash of sites can be supplied, with site names as the key, each
having a comma-seperated listing of hosts within that site.  If a host cannot
be assigned to a site, it is arbitarily assigned to the 'default' site for
path tracing purposes.

If 'use_config_hosts' is set, the configuration file is scanned for lines
in the form 'host_HOSTNAME=i.p.address' (or '1'), and 'site_SITENAME=comma,
seperate,list,of,HOSTNAMES'.

If 'myhost' and 'mysite' are not defined, they are set to the local hostname
and 'default' respectively.  If the 'send_to_one_in_site' option is set, one
copy of the message will be sent to just one host within the nominated site,
chosen randomly each time.

=item ($password, $encryption_method) = Net::Nsca::read_config( [ $configfile ]);

You probably won't need to use this, but it's available anyway.
Reads in a config file, default is /etc/nagios/send_nsca.cfg, and returns the password and encryption method. 
Dies if it can't find them.

=item %confighash = Net::Nsca::read_config_hash( [ $configfile ] );

As above, but returns all variables found within a %hash.

=back

=head1 MESSAGE OBJECT

The $message referred to looks like this, a simple hashref:

	my $message = {
		host_name => 'www',
		svc_description => 'database',
		return_code => '0',
		plugin_output => 'Database is OK',
	};

=head1 ENCRYPTION METHODS

This library support the plain (0) and XOR (1) encryption methods.  Other
encryption methods is handed off to the Mcrypt library.  Unfortunately,
as of March 2006, this does not work, with an error message of
'mcrypt is not of type MCRYPT' coming from somewhere.  Sorry.

=head1 PATH TRACING

The broadcast_message method and the 'use_trace' method is part of 
an idea of a Peer-Based Distributed Redundant Monitoring System.  The end
goal is to have a cluster of monitoring hosts, whereby any of them can fail
but all hosts and services are still monitored.

This differs from most distributed monitoring systems, where some sort of
action must be taken on the backup host when the primary host fails.  The 
main caveat with this system is that it is not known ahead of time which
monitoring host will perform which check against which host.

The key to this system is distribution of test results.  In this way, only one
monitoring host performs the actual test.  After the test is performed, the
host then sends off the result of the test to other hosts in the same mesh
of monitoring hosts.

The main problem with this is that Nagios does not distinguish between an
ocsp command run as the result of an active test, and one run as the result
of a passive test.  Either the ocsp command is run, or it is not.  This means 
that as each host checks its passive test result, it will be re-sent off to 
other hosts, possibly overwriting a newer test result made by a different host.

Enter path tracing.  This is an addition to the plugin output which identifies
which hosts this message has been sent to.  If enabled, the 
broadcast_message method observes this field, and does not send the 
message off to any host that it has already been sent to.

Note that any notification commands that are in place also need to be
aware of path tracing, to ensure that only the host that first notices
the issue sends out a notification alert.  Otherwise, each host that receives
the message will issue a notification alert, thus defeating the entire
purpose of the distributed monitoring.

The path tracing itself is kept as a series of comma-seperated strings enclosed
within brackets at the end of the plugin output line, but before any 
performance data.  Additions to the path tracing is done at the end.  Note 
that performance data will be sacrificed to fit all of the path information 
within the length limit of 512 characters.

The path information has two possible elements, identified by their prefix:
'H' (for hostname) or 'S' (for sitename).  The 'sitename' identifier is
a way of grouping a series of hosts together to save space in the path
information.

Example time.  Lets say that we have three hosts 'alpha', 'beta' and 'charlie'
in a distributed monitoring mesh given a sitename of 'callsigns' .  Host 
'alpha' performs an active check on a remote host 'indigo'.  It sends this 
result ('PING OK, 0% packet loss') off to 'beta' and 'charlie', prefixing its 
hostname ('alpha'), and then putting in the intended site ('callsigns').  The
plugin output now looks like '0% packet loss (Halpha Scallsigns)'.

When 'beta' and 'charlie' receive this message and it comes time to resend it,
the path information is examined.  They each can see the message originated
from 'alpha', and was sent to all hosts in the 'callsigns' site.  Since there
are not any other hosts apart from those in 'callsigns', both 'beta' and 
'charlie' know that there is not any point in sending it onwards.

Another example.  The host 'texas' sends a passive test result off to 'beta'.
Since 'texas' does not know about path tracing (having the basic send_nsca 
program), only the original test result is sent ('DISK OK, 500Mb available').  
When 'beta' comes around to broadcast the message, the plugin output and
path information reads '500 Mb available (Hbeta Scallsigns)'.

When multiple sites are present, the behaviour changes slightly.  When
sending a copy off to hosts in the local site, the path information is
sent with the name of all sites that this host is sending the message to.

When sending copies to a random host at the remote site, the path information
is sent with the name of all sites but that remote site.  This is so the
remote host can distribute it to hosts within that site.  Naturally, the
hosts will not attempt to send it to hosts or sites that the message has
already been to.

As a brief mention, notifications are handled by the first host to see the
message, that is, when the path information does not contain a site or a
hostname within the local site.

=head1 COPYRIGHT

See the LICENSE file. Parts are based on work by Ethan Galstad, the basic 
sending is P Kent, the aspects related to path tracing and distributed
sending are B Campbell.

=head1 PERL IMPLEMENTATION

P Kent, Started Nov 2001 $Id: Nsca.pm,v 1.12 2006/03/24 14:38:03 bc Exp $

B Campbell, Mar 2006, Added Mcrypt calls, updated to v3, hooks for distributed

=cut

#These constants are defined here, and not in the C
use constant SIZEOF_U_INT32_T	=> 4;
use constant SIZEOF_INT16_T	=> 2;
use constant SIZEOF_INIT_PACKET => TRANSMITTED_IV_SIZE + SIZEOF_U_INT32_T;

# C definition for reference is:
#	typedef struct init_packet_struct{
#		char		iv[TRANSMITTED_IV_SIZE];
#		u_int32_t	timestamp;
#		}init_packet;

# The number of bytes in the C definition is 716 bytes, yet 720 bytes is
# what is expected.  The remaining 4 bytes?  Who knows.  The first extra
# two bytes are between the packet_version and the crc32_value, and make
# sense if the int16_t (short) on some compilers becomes a long (u_int32).
# However, the second int16_t, return_code, is _not_ where the other two
# bytes sit, which would make sense if alignments are 4bytes.  This is 
# known because the following variable, hostname, does not have nulls at
# the beginning of it.  Instead, the final two bytes need to be appended 
# to the 'plugin_output', right at the end.
use constant PROBABLY_ALIGNMENT_ISSUE => 4;

use constant SIZEOF_DATA_PACKET => SIZEOF_INT16_T + SIZEOF_U_INT32_T + SIZEOF_U_INT32_T + SIZEOF_INT16_T + MAX_HOSTNAME_LENGTH + MAX_DESCRIPTION_LENGTH + MAX_PLUGINOUTPUT_LENGTH + PROBABLY_ALIGNMENT_ISSUE;

# THIS IS NOT THE PACKET AS SENT!!!
# C definition for reference is:
#	typedef struct data_packet_struct{
#		int16_t		packet_version;
#		u_int32_t	crc32_value;
#		u_int32_t	timestamp;
#		int16_t		return_code;
#		char		host_name[MAX_HOSTNAME_LENGTH];
#		char		svc_description[MAX_DESCRIPTION_LENGTH];
#		char		plugin_output[MAX_PLUGINOUTPUT_LENGTH];
#	}data_packet;

use vars qw($VERSION $AUTHOR $DEFAULT_CONFIG_FILE $DEFAULT_LOG_FILE);

($VERSION) = ('$Revision: 1.12 $' =~ m/([\d\.]+)/);
$AUTHOR = 'B Campbell';
$DEFAULT_CONFIG_FILE = '/etc/nagios/send_nsca.cfg';
$DEFAULT_LOG_FILE = '/var/nagios/rw/nagios.cmd';

### PUBLIC SUBROUTINES ##################################################

# get the two bits of information we need from the config file
sub read_config {
	my $file = shift || $DEFAULT_CONFIG_FILE;
	TRACE("read_config for $file");
	my ($password, $encryption_method);
	my %confighash = read_config_hash( $file );
	if( defined( $confighash{"password"} ) && defined( $confighash{"encryption_method"} ) ){
		$password = $confighash{"password"};
		$encryption_method = $confighash{"encryption_method"};
	}else{
		die "File did not have both password and encryption_method";
	}
	return( $password, $encryption_method );
}

# Read the config file into a hash.
sub read_config_hash {

	my $file = shift || $DEFAULT_CONFIG_FILE;
	TRACE("read_config_hash for $file");
	
	local *FILE;
	open(FILE, $file) or die("Net::Nsca - Can't open nsca config file $file for read: $!");

	my %confighash = ();
	while (<FILE>) {
		chomp;
		if( /^(\S+)=(\S+)\s*$/ ){
			$confighash{"$1"} = $2;
			TRACE( "Read config $1 is $2" );
		}
	}
	close FILE;
	
	return (%confighash);
}

#Send a message to a local instance of nagios
#[<timestamp>] PROCESS_SERVICE_CHECK_RESULT;<host_name>;<description>;<return_code>;<plugin_output>
sub local_message {
	my $message_hash = shift;
	my $log_file = shift || $DEFAULT_LOG_FILE;
	
	my @fields = qw/host_name svc_description return_code plugin_output/;

	# truncate the message, filter bad characters
	_correct_message($message_hash);
	foreach my $field (@fields) {
		$message_hash->{$field} =~ s/;/-/g;
		$message_hash->{$field} =~ s/\r/-/g;
		$message_hash->{$field} =~ s/\n/-/g;
	}
	
	# build the status check line to go in the log file
	my $string = '[' . time() . '] PROCESS_SERVICE_CHECK_RESULT;'
	. $message_hash->{'host_name'} . ';'
	. $message_hash->{'svc_description'} . ';'
	. int( $message_hash->{'return_code'} ) . ';'
	. $message_hash->{'plugin_output'} ;
	
	TRACE("Writing <$string> to $log_file");
	
	local *LOG;
	open(LOG, "> $log_file") or die("Net::Nsca - Can't open external command file: $!");
	print LOG $string, "\n";
	close LOG;
	
	TRACE("OK (local_message)");
}

# Send a messgae to a remote instance of nagios, via a remote nsca daemon.
sub send_message {
	my ($message, $remote_host, $config_file) = @_;
	my $remote_port = $_[3] || DEFAULT_SERVER_PORT;
	
	my ($password, $encryption_method) = read_config( $config_file );
	
	# truncate bits of the message if needed...
	_correct_message($message);

	my $socket = _connect( FG => 1, Timeout => DEFAULT_SOCKET_TIMEOUT, Host => $remote_host, Port => $remote_port ) || die( "Net::Nsca - Can't make socket: $!" );

	# Get the init packet.
	my $init_packet = _read_init_packet( $socket, DEFAULT_SOCKET_TIMEOUT );
	die("Net::Nsca - Bad Packet length/Short read from $remote_host") unless(defined( $init_packet ) );


	# this is here for debugging really, the value should be the number of seconds since the epoch.
	$init_packet->{timestamp_perlish} = unpack('N', $init_packet->{timestamp});

	#TRACE("Init Packet IV Follows:\n" . _escape( $init_packet->{iv} ));
	#TRACE("Init Packet time Follows:\n" . _escape( $init_packet->{timestamp} ));
	#TRACE("Unpacked version is $init_packet->{timestamp_perlish}");

	my $data_packet_string_crypt = _assemble_packet( Init => $init_packet, Message => $message, Password => $password, Encryption => $encryption_method );
	die("Net::Nsca - Don't know how to encrypt that way") unless( defined( $data_packet_string_crypt ) );

	die("Net::Nsca - Bad packet created, wrong length") unless ( length( $data_packet_string_crypt ) == SIZEOF_DATA_PACKET );
	# TRACE("Sending packet: " .  _escape( $data_packet_string_crypt ));
	$socket->syswrite($data_packet_string_crypt);
	$socket->close();
	
	# destroy the socket because it now goes out of scope
	TRACE("OK (send_message)");
}

# Prepare to broadcast the message off to lots of hosts.
sub broadcast_message {
	my %args = (	message => undef,
			hosts => (),
			timeout => DEFAULT_SOCKET_TIMEOUT,
			config_file => $DEFAULT_CONFIG_FILE,
			remote_port => DEFAULT_SERVER_PORT,
			use_trace => 0,
			use_config_hosts => 0,
			myhost => undef,
			mysite => undef,
			send_to_one_in_site => undef,
			@_,
			);

	# Read in the configuration file.
	my %confighash = read_config_hash( $args{"config_file"} );

	TRACE( "Read in config file" );

	# Number of hosts that it was sent to.
	my $retsent = 0;

	# The actual message.
	return( -1 ) unless( defined( $args{"message"} ) );
	my $message = $args{"message"};

	TRACE( "Have message" );

	# Get what our hostname is.  We avoid sending to ourselves.
	my $myhost = $args{"myhost"};
	if( ! defined( $myhost ) ){
		$myhost = hostname();
	}elsif( $myhost =~ /^\s*$ / ){
		$myhost = hostname();
	}

	TRACE( "myhost is $myhost " . $args{"use_trace"} . " X" );
	my $addr = inet_ntoa(scalar gethostbyname($myhost || 'localhost'));

	# Get a list of hosts and sites from the options.
	my %hosts = ();
	my %sites = ();

	# Run through the supplied host listing.  This is in addition
	# to any hosts supplied from the config file, if we are permitted
	# to run through that.
	if( defined( $args{"hosts"} ) ){
		foreach my $host( keys %{$args{"hosts"}} ){
			next unless( defined( $host ) );
			next if( $host =~ /^\s*$/ );
			my $tip = $args{"hosts"}{"$host"};
			next unless( defined( $tip ) );
			next if( $tip =~ /^\s*$/ );
			TRACE( "Found host $host" );
			if( $tip !~ /(\.|\:)/ ){
				$hosts{"$host"} = $host;
			}else{
				$hosts{"$host"} = $tip;
			}
		}
	}

	# If hosts are listed in sites, but not in the hosts listing,
	# they will not be sent to.
	if( defined( $args{"sites"} ) ){
		TRACE( "There are sites" );
		foreach my $site( keys %{$args{"sites"}} ){
			next unless( defined( $site ) );
			next if( $site =~ /^\s*$/ );
			next unless( defined( $args{"sites"}{"$site"} ) );
			TRACE( "Found site $site" );
			my $thesehosts = $args{"sites"}{"$site"};
			next unless( defined( $thesehosts ) );
			next if( $thesehosts =~ /^\s*$/ );
			my @tsplit = split( /,/, $thesehosts );
			foreach my $tval( @tsplit ){
				next unless( defined( $tval ) );
				next unless( $tval =~ /^\s*(\S+)\s*$/ );
				$sites{"$site"}{"$1"}++;
			}
		}
	}

	# Grab the hosts and sites from the configuration file.
	if( $args{"use_config_hosts"} ){
		foreach my $ckey( keys %confighash ){
			next unless( defined( $ckey ) );
			next unless( $ckey =~ /^\s*(host|site)_(\S+)\s*$/ );
			my $type = $1;
			my $name = $2;
			next unless( defined( $confighash{"$ckey"} ) );
			next if( $confighash{"$ckey"} =~ /^\s*$/ );

			if( $type eq "host" ){
				# Name is a hostname, value is possibly an
				# IP address.  IP addresses supplied via the
				# function win.
				if( $confighash{"$ckey"} !~ /(\.|\:)/ ){
					if( ! defined( $hosts{"$name"} ) ){
						$hosts{"$name"} = $name;
					}
				}elsif( ! defined( $hosts{"$name"} ) ){
					$hosts{"$name"} = $confighash{"$ckey"};
				}elsif( $hosts{"$name"} !~ /^(\d+\.\d+\.\d+\.\d+|[A-Fa-f0-9:\/]+)$/ ){
					$hosts{"$name"} = $confighash{"$ckey"};
				}
			}elsif( $type eq "site" ){
				# Name is a sitename, value is a comma-seperated
				# list of hostnames.
				my @tsplit = split( /,/, $confighash{"$ckey"} );
				foreach my $tval( @tsplit ){
					next unless( defined( $tval ) );
					next unless( $tval =~ /^\s*(\S+)\s*$/ );
					$sites{"$name"}{"$1"}++;
				}
			}
		}
	}

	# Finally, everything has to be in a site.  We arbitarily decide
	# that any host which is not in a site gets put into the 'default'
	# site.
	foreach my $host( keys %hosts ){
		next unless( defined( $host ) );
		next if( $host =~ /^\s*$/ );
		TRACE( "Found host $host" );
		my $foundsite = undef;
		foreach my $site( keys %sites ){
			next if( defined( $foundsite ) );
			next unless( defined( $site ) );
			next if( $site =~ /^\s*$/ );
			next unless( defined( $sites{"$site"}{"$host"} ) );
			TRACE( "Host $host is in site $site" );
			$foundsite = $site;
		}

		# If the host was not found in any site, add it to the
		# "default" site.
		if( ! defined( $foundsite ) ){
			TRACE( "Host $host was not in any site, adding to default" );
			$sites{"default"}{"$host"}++;
			if( $host eq $myhost ){
				$mysite = "default";
			}
		}else{
			# Make sure that '$mysite' is defined.
			if( $host eq $myhost && ! defined( $mysite ) ){
				$mysite = $foundsite;
			}
		}
	}

	# Last chance to make sure that there is something in $mysite.  It
	# may not be correct, but it will be there.
	if( ! defined( $mysite ) ){
		TRACE( "Setting mysite to default" );
		$mysite = "default";
	}

	# Get any path information.
	my $curplug = undef;
	my $curperf = undef;
	my @curpath = ();
	my %prevhosts = ();
	my %prevsites = ();
	if( $message->{'plugin_output'} =~ /\S+/ ){
		my $prevpath = undef;
		my @tsplit = split( /\|/, $message->{'plugin_output'} );
		if( $tsplit[0] =~ /^(.*)\(([^\)]+)\)\s*$/ ){
			$curplug = $1;
			$prevpath = $2;
			TRACE( "previous path is $prevpath" );
		}else{
			$curplug = $tsplit[0];
		}

		my $maxval = (scalar @tsplit ) - 1;
		if( $maxval > 0 ){
			$curperf = join( '|', @tsplit[1..$maxval] );
		}

		if( defined( $prevpath ) && $args{"use_trace"} ){
			my @psplit = split( /,/, $prevpath );
			foreach my $tval( @psplit ){
				next if( $tval =~ /^\s*$/ );
				if( $tval =~ /^\s*H(\S+)\s*$/ ){
					$prevhosts{"$1"}++;
				}elsif( $tval =~ /^\s*S(\S+)\s*$/ ){
					$prevsites{"$1"}++;
				}
				push @curpath, $tval;
			}
		}elsif( ! $args{"use_trace"} ){
			$curplug = $tsplit[0];
		}
	}

	# Edit the path information to include the local
	# hostname and sitename.
	push @curpath, "H" . $myhost;
	push @curpath, "S" . $mysite;

	# Get connections to local hosts.
	my %connections = ();
	my %sockaddrs = ();
	my %localdesthosts = ();
	if( ! defined( $prevsites{"$mysite"} ) ){
		# All of our local ones.
		foreach my $host( keys %{$sites{"$mysite"}} ){
			next unless( defined( $host ) );
			next if( $host =~ /^\s*$/ );
			next unless( defined( $hosts{"$host"} ) );
			next if( $host eq $myhost );
			next if( defined( $prevhosts{"$host"} ) );

			# Attempt to open a connection to that host.
			$localdesthosts{"$host"}++;
			TRACE( "Checking connection for $host " . $args{"timeout"} . "foo" );
			$connections{"$host"} = _connect( FG => 0, Timeout => $args{"timeout"}, Host => $hosts{"$host"}, Port => $args{"remote_port"} );
                        $sockaddrs{"$host"} = sockaddr_in( $args{"remote_port"}, inet_aton( $hosts{"$host"} ) );
			TRACE( "Storing sockaddr for  $host " );
		}
	}

	# Get connections to any remote sites (we try to connect to just one
	# host in a given site, so we save on traffic)
	TRACE( "Running through remote sites" );
	my %remotesites = ();
	foreach my $site( keys %sites ){
		next unless( defined( $site ) );
		next if( $site =~ /^\s*$/ );
		next if( defined( $prevsites{"$site"} ) );
		next if( $site eq $mysite );

		if( defined( $args{"send_to_one_in_site"} ) ){
			next unless( $site eq $args{"send_to_one_in_site"} );
		}

		# We attempt to open a connection to a random host within
		# that site.  
		my $gothost = 0;
		foreach my $host( sort { int( rand( 2 ) ) - 1 } keys %{$sites{"$site"}} ){
			next if( $gothost );
			next unless( defined( $host ) );
			next if( $host =~ /^\s*$/ );
			next unless( defined( $hosts{"$host"} ) );
			next if( $host eq $myhost );
			next if( defined( $connections{"$host"} ) );
			next if( defined( $prevhosts{"$host"} ) );
			$connections{"$host"} = _connect( FG => 0, Timeout => $args{"timeout"}, Host => $hosts{"$host"}, Port => $args{"remote_port"} );
                        $sockaddrs{"$host"} = sockaddr_in( $args{"remote_port"}, inet_aton( $hosts{"$host"} ) );
			if( defined( $connections{"$host"} ) ){
				$gothost++;
				$remotesites{"$site"} = $host;
			}
		}
	}
		
	# Run through and see if any of the hosts we're trying to 
	# connect to have finished their connections yet.
	my $stime = time;
	my $etime = time + $args{"timeout"};
	my $mtime = time + $args{"timeout"} + $args{"timeout"};
	my $conncount = 0;
	TRACE( "Checking whether connections have finished" );
	while( time < $mtime ){
		my $foundcount = 0;
		my $stillconn = 0;
		my %notconn = ();
		$conncount = 0;
		my $numrefused = 0;
		my %whichrefused = ();
		foreach my $host( keys %connections ){
			next unless( defined( $host ) );
			next if( $host =~ /^\s*$/ );
			next unless( defined( $connections{"$host"} ) );
			# TRACE( "Checking connection for $host" );
			$foundcount++;
			$connections{"$host"}->connect( $sockaddrs{"$host"} );
			# TRACE( "Finished connect for $host" );
			my $lres = $!;
			# TRACE( "Connect for $host is $lres" );
			if( $lres != EISCONN ){
				$stillconn++;
				$notconn{"$host"}++;
				if( $lres != EINPROGRESS && $lres != EALREADY ){
					TRACE( "Connection refused for $host" );
					$numrefused++;
					$whichrefused{"$host"}++;
				}
			}else{
				$conncount++;
			}
		}

		# All connections succeeded.  Time to exit.
		if( $foundcount > 0 && $stillconn == 0 ){
			TRACE( "Setting mtime to time" );
			$mtime = time;
		}elsif( $foundcount == $numrefused && $numrefused > 0 ){
			TRACE( "All supplied hosts refused connection." );
			$mtime = time;
		}elsif( $foundcount == 0 ){
			TRACE( "No known hosts!" );
			$mtime = time;

		# Some connections are failing.  Time to close them down.
		}elsif( time >= $etime || $numrefused > 0 ){
			# Some connections are not succeeding.  Delete
			# any that have not connected from the remote host.
			if( $time >= $etime ){
				$etime = $mtime;
				$numrefused = 0;
			}

			foreach my $host( keys %notconn ){
				next unless( defined( $host ) );
				next if( $host =~ /^\s*$/ );
				next unless( defined( $connections{"$host"} ) );

				# There were refusals, but this is not one of them.
				next if( $numrefused > 0 && ! defined( $whichrefused{"$host"} ) );
				close( $connections{"$host"} );

				# Was this a local or remote?
				foreach my $site( keys %remotesites ){
					next unless( $remotesites{"$site"} eq $host );
					# It was a remote.  Try to pick another
					# host in that site, if one exists.
					my $gothost = 0;
					foreach my $thost( sort { int( rand( 2 ) ) - 1 } keys %{$sites{"$site"}} ){
						next if( $gothost );
						next unless( defined( $thost ) );
						next if( $thost =~ /^\s*$/ );
						next unless( defined( $hosts{"$thost"} ) );
						next if( $thost eq $myhost );
						next if( exists( $connections{"$thost"} ) );
						next if( defined( $prevhosts{"$host"} ) );
						$connections{"$thost"} = _connect( FG => 0, Timeout => $args{"timeout"}, Host => $hosts{"$thost"}, Port => $args{"remote_port"} );
						$sockaddrs{"$host"} = sockaddr_in( $args{"remote_port"}, inet_aton( $hosts{"$thost"} ) );
						if( defined( $connections{"$thost"} ) ){
							$gothost++;
							$remotesites{"$site"} = $thost;
						}
					}

					# Clear it.
					if( ! $gothost ){
						$remotesites{"$site"} = undef;
					}
				}

				# Set this one to be undefined, but don't
				# delete it, as a host may be in multiple
				# sites.
				$connections{"$host"} = undef;
				TRACE("Cancelling connection to $host");
			}
		}
	}

	TRACE( "Got all ($conncount) connections, took " . ( time - $stime ) . " seconds" );

	# Run through the connections again, this time trying to get the
	# initial packets.
	my %init_packets = ();

	# Put the timeout forward again.
	$etime = time + $args{"timeout"};
	my $gotall = 0;
	while( ! $gotall || time > $etime ){
		my $foundcount = 0;
		$gotall = 0;
		foreach my $host( keys %connections ){
			next unless( defined( $host ) );
			next if( $host =~ /^\s*$/ );
			next unless( defined( $connections{"$host"} ) );
			$foundcount++;
			if( defined( $init_packets{"$host"} ) ){
				$gotall++;
				next;
			}

			$connections{"$host"}->connect( $sockaddrs{"$host"} );
			if( $! == EISCONN ){
				my $init_packet = _read_init_packet( $connections{"$host"}, 0 );
				if( defined( $init_packet ) ){
					$init_packets{"$host"} = $init_packet;
					TRACE("Got init packet from $host");
				}
			}
		}

		if( $foundcount == $gotall && $gotall > 0 ){
			$gotall = 1;
		}elsif( $foundcount == 0 ){
			$gotall = 1;
		}else{
			$gotall = 0;

			# Wait a little bit, as we don't have everything
			# from the remote end.
			select( undef, undef, undef, 0.1 );
		}

		
	}

	# Are you getting duplicate notifications from within the same 
	# site?  Have you checked that every host can sent to every other
	# host within the same site?  Otherwise, a message generated by
	# one host may not reach all other hosts within the same site, and
	# thus another host within the same site may perform the same
	# test and issue a duplicate notification.

	# Run through each init packet that we have, generate a new
	# message with particular path tracing, and send out the message.
	foreach my $host( keys %init_packets ){
		next unless( defined( $host ) );
		next if( $host =~ /^\s*$/ );
		next unless( defined( $connections{"$host"} ) );
		next unless( defined( $init_packets{"$host"} ) );
		TRACE("Considering $host for sending");

		# Prepare the new message.  Easier to do this then continually
		# putting the old message back.
		my $newmessage = {	
					host_name => $message->{'host_name'},
					svc_description => $message->{'svc_description'},
					return_code => $message->{'return_code'},
					plugin_output => $curplug,
				};

		# Prepare the path information.  We add in every site but
		# the one we are sending to.
		my @thesesites = ();
		foreach my $site( keys %remotesites ){
			next unless( defined( $site ) );
			next if( $site =~ /^\s*$/ );
			next unless( defined( $remotesites{"$site"} ) );

			# Don't mention our own site, as that has already been
			# added to the current path ages ago.
			next if( $site eq $mysite );

			# Don't mention the site that this host belongs to.
			# If we do, then that remote site will not have the
			# message propagated around it.
			next if( $remotesites{"$site"} eq $host );

			# This line is important, as it means that any sites
			# which we were not able to get an init packet from
			# will not be included.  Thus, any host which receives
			# this packet will attempt to send the packet on to
			# that remote site.  
			next unless( defined( $init_packets{$remotesites{"$site"}} ) );
			push @thesesites, "S" . $site;
		}

		# Add in the path information if we're allowed to.
		if( $args{"use_trace"} ){
			$newmessage->{'plugin_output'} .= " (" . join( ',', @curpath, @thesesites ) . ")";
		}

		# Add in the current performance details.
		if( defined( $curperf ) ){
			$newmessage->{'plugin_output'} .= "| $curperf";
		}

		# Correct length issues.
		_correct_message($newmessage);

		# TRACE( $confighash{"password"} . $confighash{"encryption_method"} );
		# Time to submit.
		my $data_packet_string_crypt = _assemble_packet( Init => $init_packets{"$host"}, Message => $newmessage, Password => $confighash{"password"}, Encryption => $confighash{"encryption_method"} );

		my $didsend = 0;
		if( defined( $data_packet_string_crypt ) ){
			if( length( $data_packet_string_crypt ) == SIZEOF_DATA_PACKET ){
				# TRACE("Sending packet to $host: " .  _escape( $data_packet_string_crypt ));
				TRACE( "Sending packet to $host" );
				$connections{"$host"}->syswrite($data_packet_string_crypt);
				$connections{"$host"}->close();
				$retsent++;
				$didsend++;
			}
		}

		if( ! $didsend ){
			if( defined( $data_packet_string_crypt ) ){
				warn( "Net::Nsca: Encryption of message to $host resulted in wrong size: " . length( $data_packet_string_crypt ) . " vs " . SIZEOF_DATA_PACKET . " X\n " );
			}else{
				warn( "Net::Nsca: Unknown or non-working encryption method specified: " . $confighash{"encryption_method"} . "\n" );
			}
		}
	}
	TRACE("OK - $retsent (broadcast_message) ");
	
	return( $retsent );
}
			
			

### PRIVATE SUBROUTINES #################################################

# truncates long fields
sub _correct_message {
	my $message = shift;

	if (length( $message->{'host_name'} ) >= MAX_HOSTNAME_LENGTH) {
		warn("Net::Nsca - Hostname too long - truncated");
		$message->{'host_name'} = substr($message->{'host_name'}, 0, MAX_HOSTNAME_LENGTH-1);
	}
	if (length( $message->{'svc_description'} ) >= MAX_DESCRIPTION_LENGTH) {
		warn("Net::Nsca - Description too long - truncated");
		$message->{'svc_description'} = substr($message->{'svc_description'}, 0, MAX_DESCRIPTION_LENGTH-1);
	}
	if (length( $message->{'plugin_output'} ) >= MAX_PLUGINOUTPUT_LENGTH) {
		warn("Net::Nsca - Plugin Output too long - truncated");
		$message->{'plugin_output'} = substr($message->{'plugin_output'}, 0, MAX_PLUGINOUTPUT_LENGTH-1);
	}
	return $message;
}

# central switchboard for encryption methods.
sub _encrypt {
	my ($data_packet_string, $encryption_method, $iv_salt, $password) = @_;
	TRACE("encrypt method $encryption_method X");
	
	my $crypted;
	if ($encryption_method == ENCRYPT_NONE) {
		$crypted = $data_packet_string;
	} elsif ($encryption_method == ENCRYPT_XOR) {
		$crypted = _encrypt_xor($data_packet_string, $iv_salt, $password);
	} else {
		$crypted = _encrypt_mcrypt( $data_packet_string, $encryption_method, $iv_salt, $password );
	}
	return $crypted;
}

sub _encrypt_xor {
	my ($data_packet_string, $iv_salt, $password) = @_;

	my @out = split(//, $data_packet_string);
	TRACE("Out buffer is " . scalar(@out) . " items long");
	my @salt_iv = split(//, $iv_salt);
	my @salt_pw = split(//, $password);
	
	my $y = 0;
	my $x = 0;

	#/* rotate over IV we received from the server... */
	while ($y < SIZEOF_DATA_PACKET) {
		#/* keep rotating over IV */
		$out[$y] = $out[$y] ^ $salt_iv[$x % scalar(@salt_iv)];

		$y++;
		$x++;
	}

	#/* rotate over password... */
	$y=0;
	$x=0;
	while ($y < SIZEOF_DATA_PACKET){
		#/* keep rotating over password */
		$out[$y] = $out[$y] ^ $salt_pw[$x % scalar(@salt_pw)];

		$y++;
		$x++;
	}
	return( join('',@out) );
}

sub _encrypt_mcrypt {
	my ( $data_packet_string, $encryption_method, $iv_salt, $password ) = @_;
	my $crypted = undef;
	TRACE( "_encrypt_mcrypt started with $encryption_method and $HAVE_MCRYPT" );
	my $evalok = 0;
	if( $HAVE_MCRYPT ){
		# Initialise the routine
		if( defined( $mcrypts{$encryption_method} ) ){
			# Load the routine.
			my $routine = "Mcrypt::" . $mcrypts{$encryption_method};
			TRACE( "About to load the routine " . $mcrypts{$encryption_method} . " $routine" );
			eval {
				# This sometimes dies with 'mcrypt is not of type MCRYPT'.
				my $td = Mcrypt->new( algorithm => $routine, mode => Mcrypt::CFB, verbose => 1 );
				TRACE( "new returned $td" );
				my($key) = $password;
				my($iv) = $iv_salt;
				if( defined( $td ) ){
					$td->init($key, $iv);
					$crypted = $td->encrypt( $data_packet_string );
					$td->end();
				}
				$evalok++;
			};
		}
	}

	# Mcrypt is fastest, but for some routines, there are alternatives if
	# your perl Mcrypt <-> libmcrypt linkage isn't working.
	if( ! $evalok && ! defined( $crypted ) && defined( $encryption_method )){
		if( defined( $mcrypts{$encryption_method} ) && 1 == 2 ){
			my $routine = "_encrypt_" . $mcrypts{$encryption_methods};
			if( $routine !~ /_$/ ){
				eval {
					$crypted = $routine( $data_packet_string, $encryption_method, $iv_salt, $password );
				};
			}
		}
	}
	return( $crypted );
}


#/* calculates the CRC 32 value for a buffer */
sub _calculate_crc32 {
	TRACE("calculate_crc32");
	my $string = shift;

	my $crc32_table = _generate_crc32_table();
	my $crc = 0xFFFFFFFF;

	foreach my $tchar (split(//, $string)) {
		my $char = ord($tchar);
		$crc = (($crc >> 8) & 0x00FFFFFF) ^ $crc32_table->[($crc ^ $char) & 0xFF];
	}

	return ($crc ^ 0xFFFFFFFF);
}

#/* build the crc table - must be called before calculating the crc value */
sub _generate_crc32_table {
	TRACE("generate_crc32_table");
	my $crc32_table = [];
	my $poly = 0xEDB88320;
	
	for (my $i = 0; $i < 256; $i++){
		my $crc = $i;
		for (my $j = 8; $j > 0; $j--) {
			if ($crc & 1) {
				$crc = ($crc >> 1) ^ $poly;
			} else {
				$crc = ($crc >> 1);
			}
		}
		$crc32_table->[$i] = $crc;
 	}
	return $crc32_table;
}

# borrowed from CGI.pm
sub _escape {
    my $toencode = shift;
    $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf(" %%%02x",ord($1))/eg;
    return $toencode;
}

sub _connect {
	# my $socket = _connect( FG => 1, Timeout => DEFAULT_SOCKET_TIMEOUT, Host => $remote_host, Port => $remote_port ) || die( "Net::Nsca - Can't make socket: $!" );
	my %args = (	FG => 1,
			Timeout => 10,
			Host => undef,
			Port => undef,
			@_,
			);

	# connect to the nsca server, which will almost certainly be the machine on which netsaint is running
	TRACE("Trying to make socket to host <" . $args{"Host"} . "> port <" . $args{"Port"} . ">");
	my $socket = undef;

	my $cango = 0;
	if( defined( $args{"Timeout"} ) && defined( $args{"Host"} ) && defined( $args{"Port"} ) ){
		$cango++;
	}

	# Foreground connection.
	if( $args{"FG"} && $cango ){
		# Returns a socket after it has connected.
		$socket = IO::Socket::INET->new(
			PeerAddr => $args{"Host"},
			PeerPort => $args{"Port"},
			Type => SOCK_STREAM,
			Proto => 'tcp',
			Timeout => args{"Timeout"},
		);

	# Background connection.
	}elsif( ! $args{"FG"} && $cango ){
		TRACE( "Background connection" );
		# Returns a socket after the initial SYN has been sent.
		# Some fancy footwork is needed later to see whether
		# the connection suceeded.
		$socket = IO::Socket::INET->new(
			# PeerAddr => $args{"Host"},
			# PeerPort => $args{"Port"},
			Type => SOCK_STREAM,
			Proto => 'tcp',
			# Timeout => $args{"Timeout"},
			Blocking => 0,
		);
	}
	TRACE( "Returning $socket X" );
	return( $socket );
}

sub _read_init_packet {
	my $socket = shift;
	my $timeout = shift;

	# get init packet that contains the session salt value
	my $init_packet_buf;

	# See if the packet is available.  Lot of dancing around just
	# to invoke select.
	my $rin = '';
	vec( $rin, fileno( $socket ), 1 ) = 1;
	my $rout = '';

	# Only check readability; we don't care about writability at the
	# present time.
	my ( $nfound, $timeleft ) = select($rout=$rin, undef, undef, $timeout);

	# Did we get anything?
	if( $nfound ){

		# This could fail, if some broken TCP implementation is
		# sending one byte per packet.  
		$socket->sysread($init_packet_buf, SIZEOF_INIT_PACKET);

		TRACE("Init packet is " . length($init_packet_buf) . " bytes long");
		if( length( $init_packet_buf ) == SIZEOF_INIT_PACKET ){

			my $init_packet = {
				iv => substr($init_packet_buf, 0, TRANSMITTED_IV_SIZE),
				timestamp => substr($init_packet_buf, TRANSMITTED_IV_SIZE, SIZEOF_U_INT32_T),
			};

			return( $init_packet );
		}else{
			return( undef );
		}
	}else{
		return( undef );
	}
}

sub _assemble_packet {
	my %args = (	Init => undef,
			Message => undef,
			Password => undef,
			Encryption => undef,
			@_,
			);

	# assemble our data
	# in two halves
	# PROBABLY_ALIGNMENT_ISSUE - two nulls need to be appended after
	# the packet version.
	my $data_packet_string_a = pack('n', NSCA_PACKET_VERSION_3) . "\000\000";
	# my $data_packet_string_a = "\000\000" . pack('n', NSCA_PACKET_VERSION_3);
	# my $data_packet_string_a = pack('n', NSCA_PACKET_VERSION_3);

# C definition for reference is:
#	typedef struct data_packet_struct{
#		int16_t		packet_version;
#		u_int32_t	crc32_value;
#		u_int32_t	timestamp;
#		int16_t		return_code;
#		char		host_name[MAX_HOSTNAME_LENGTH];
#		char		svc_description[MAX_DESCRIPTION_LENGTH];
#		char		plugin_output[MAX_PLUGINOUTPUT_LENGTH];
#	}data_packet;
		  # pack('N', $args{"Init"}->{'timestamp'} )
	my $data_packet_string_b = 
		  $args{"Init"}->{'timestamp'}
		. pack('n', $args{"Message"}->{'return_code'})
		. pack(('a'.MAX_HOSTNAME_LENGTH), $args{"Message"}->{'host_name'})
		. pack(('a'.MAX_DESCRIPTION_LENGTH), $args{"Message"}->{'svc_description'})
		. pack(('a'.MAX_PLUGINOUTPUT_LENGTH), $args{"Message"}->{'plugin_output'})
		. "\000\000"
	;


	# PROBABLY_ALIGNMENT_ISSUE - two nulls need to be appended after
	# everything.

	# now we compute the CRC of the whole string, with NULs in place of the 32 bit CRC
	# my $crc = _calculate_crc32( $data_packet_string_a . "\000\000\000\000" . $data_packet_string_b);
	my $crc = _calculate_crc32( $data_packet_string_a . pack( 'N', 0 ) . $data_packet_string_b);

	# insert CRC into data string
	my $data_packet_string = ( $data_packet_string_a . pack('N', $crc) . $data_packet_string_b);

	# encrypt data
	my $data_packet_string_crypt = _encrypt($data_packet_string, $args{"Encryption"}, $args{"Init"}->{'iv'}, $args{"Password"});

	# return data
	# TRACE("Packet is " . length( $data_packet_string_crypt ) . " bytes long");
	return( $data_packet_string_crypt );
}

# Encryption functions not using the Mcrypt library.
sub _encrypt_DES {
	my( $string, $throw, $salt, $password ) = (@_);
}


sub TRACE { 
	my $arg = shift;
	chomp( $arg );
	print STDERR time . " TRACE: $arg\n"; 
}

1;