#!/usr/pkg/bin/perl -w
#
# NLANR/DAST Multicast Beacon, using Perl module Net::Multicast::Beacon
# August 26, 2005 -- Version 1.3-0	
# 
# See RFC-3550 for information on the underlying RTP protocol used here.
#
##-----------------------------------------------------------------------------
# NOTE: Set tab stops to four to display this file properly in an 
# 80-column window.
#
# 	For vi, edit file ~/.vimrc and set tabstop to 4.  Ie:
#
#		vi ~/.vimrc
#
#			set tabstop=4
#
#		
##-----------------------------------------------------------------------------

##-----------------------------------------------------------------------------
#
# Start of DEFINES section
#
##-----------------------------------------------------------------------------

use strict;

use lib "/usr/lib/perl5/5.8.1/i386-linux-thread-multi";
use lib "/usr/local/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi";

$| = 1;	# Set autoflush

use Time::HiRes qw( usleep time gettimeofday );	# For precise timing
use Net::Multicast::Beacon;		# Make rtp.c RTP calls available in Perl
use Getopt::Long;				# Allow both -g -p and --group --port cmd lines
use IO::Socket;					# For reverse IP lookups to get hostname
use IO::Select;
use Net::Domain;				# For getting the FQDN of the current host
use Sys::Hostname;				# Other way of getting the name of the current host

# Allow us to set the TCP central server listen to be non-blocking
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

# To convert Epoch time to Human Readable format
require "ctime.pl";

my $childpid;

# For month name to month number calculations
my %mth = ("Jan"=>1, "Feb"=>2, "Mar"=>3, "Apr"=>4, "May"=>5, "Jun"=>6, 
		"Jul"=>7, "Aug"=>8, "Sep"=>9, "Oct"=>10, "Nov"=>11, "Dec"=>12);

my $SLEEP	= 80;		# Milliseconds to sleep btwn event checks in main loop

my $VER		= "1.3";		# What version of the Beacon is this?
my $SUBVER	= 0;			# Subversion -- Only used for display

# All set in beacon.conf
my $GROUP	= "";			# Multicast Group to use 
my $PORT	= "";			# Multicast Port for RTP to use
my $TTL		= "";			# TTL to use
my $RTCP_PORT;				# RTCP port for Beacon to use

# All set in beacon.conf
my $CONTACTNAME;		# Whose Beacon is this?
my $CONTACTINFO;		# How do we reach them? (email, phone)
my $CONTACTLOCATION;	# Where, geographically, are they?
my $NOTIFYEMAIL;		# Email address for future alarm/notification features

# All set in beacon.conf
my $CENTRALSERVERNAME;	# Hostname of Central Server
my $SERVERTCPPORT;		# TCP port for Beacon to use for Central Server reports
my $becentralserver;	# Is "this" Beacon acting as a Central Server?
my $noshutdownmsg;		# Write a message to HTML files on shutdown or not
my $showip;				# Show IP address in main HTML display
my $showmotd;			# Show the MOTD defined in beacon.conf?
my $showssrc;			# Show SSRC values in main HTML display?
my $showreports;		# Show the RTCP RR report count in main HTML display?

# See RFC-3550 - Maximum  bandwidth to allocate to RTP for reporting
my $BANDWIDTH      = "64000";

# Do we have a connection to the Central Server?
my $connection_to_tcp_server = 0;

# Flags for handling the processing of beacon.conf
my $showversion;		# Show the version info for Beacon and exit
my $background=0;		# Background the process on startup? (Default = no)
my $stopme;				# Stop user running Beacon before editing beacon.conf
my $needs_help;			# Show help/usage info then exit
my $erasehistory;		# If Central Server, erase history file at startup
my $writehistory;		# If Central Server, output flast-test CVS history info 

# Directory out to which to write files
my $outputdir;

# Which network interface to use, for machines w/ multiple NICs
# Specify the quoted dotted quad to use this, ie, "141.142.98.109"
my $interface;

# For processing commandline options
my %opts;

# Session pointer for main RTP protocol
my $session;

# Event pointer for main RTP protocol
my $event;

# Setup the buffer to send as the raw "data".
my $buf  = "Beacon $VER";	# The actual raw RTP "data" to send - tcpdump shows

# The RTP timestamp for transmission
my $rtp_ts;


# Hash tables used by the Beacon
my %ssrc_lookup;			# sortname to SSRC hash
my %sort_lookup;			# SSRC to sortname hash
my %host_lookup;			# SSRC to hostname hash
my %ip_lookup;				# SSRC to IP hash

my %tcp_ssrc_lookup;		# Central Server sortname to SSRC hash
my %tcp_sort_lookup;		# Central Server SSRC to sortname hash
my %tcp_host_lookup;		# Central Server SSRC to hostname hash
my %tcp_ip_lookup;			# Central Server SSRC to IP hash
my %tcp_meta;				# Central Server SSRC to metadata hash

my %stats;					# Where to keep the overall stats
my %reports;				# Count of reports from each SR during each interval
my %tcp_reports;			# Count of reports from each SR during each interval
my %tcp_stats;				# Separate hash for TCP Central Server stats
my %blind;					# List of blind Beacons for html_prefilter()
my $totalblind;				# How many blind Beacons does prefilter catch?


# Index values for stats hash where Beacon SR/RR stats pairings are recorded
my $FRACT_LOST		= 0;	# RTP Fractional (instantaneous) loss/packet
my $TOTAL_LOST		= 1;	# Total number of RTP packets lost so far
my $JITTER			= 2;	# Statistical variation in delay
my $LAST_SEQ		= 3;	# Highest packet sequence value so far - Expected
my $TIMESTAMP		= 4;	# RTP Timestamp -- See RFC-3550
my $RTT				= 5;	# Round Trip Time
my $INTERVAL_LOSS	= 6;	# Loss over reporting interval
#my $UNUSED			= 7;
#my $UNUSED2		= 8;
my $PREV_LOST		= 9;	# Previous (interval) total_lost value
my $PREV_SEQ		= 10;	# Previous (interval) last_seq value
#my $UNUSED3			= 11;
#my $UNUSED4			= 12;
my $PREV_LOSS_VAL	= 13;	# Last value for loss when no new reports rec'd
my $RTT_TOTAL		= 14;	# Holding var for running RTT total
my $RTT_COUNT		= 15;	# Count of number of reports for this RTT pair

# Values for metadata on each Beacon client. Used by  %tcp_meta.
# tcp_meta index values
my $USER		= 0;	# User name Beacon is running as.  Ie., "mitch"
my $OS			= 1;	# OS name beacon is running under. Ie., "linux"
my $NAME		= 2;	# CONTACTNAME
my $INFO		= 3;	# CONTACTINFO
my $LOC			= 4;	# CONTACTLOCATION
my $START		= 5;	# When started?
my $LAST_HEARD	= 6;	# When last heard from?
my $PERLVER		= 7;	# What version of Perl is this Beacon running under?
my $NOTIFY		= 8;	# Email address for future Alarm/Notification features
my $PBTEST		= 9;	# Previous Burst test time
my $BTEST		= 10;	# Next Burst test time
my $PSTEST		= 11;	# Previous Silence test time
my $STEST		= 12;	# Next Silence test time


my $child;
my $parent;
# Server socket pointer for TCP connection listening for incoming reports
my $server;
my $select;
my $client;

# Flags for TCP reports
my $DATALINE		= 1;	# A line of data
my $DELETETCPENTRY	= 2;	# Signal to delete this Beacon from TCP reports

my $ENDMESSAGE = "ZZZ\n";


# (2**32) - 1		For RTT calculations
my $TWOTOTHETHIRTYSECONDMINUSONE = 4294967295.0;   # (2**32) - 1

# Number of seconds between 1900 and 1970.  For RTT calculations
my $SECS_BETWEEN_1900_1970	= 2208988800;

# Number of seconds in two hours
my $TWOHOURS				= 7200;

# Refresh the web pages every N seconds
my $WEBREFRESH				= 60;

# Central Server will delete a Beacon is hasn't heard from in N seconds
my $TIMEOUT_DELETE			= 300;	# Five minutes	- Allows for silence testing

# Time between updates of the history.txt file
my $HSECS					= 600;

# THIS Beacon info
my $thissession;	# Pointer to session struct
my $thisssrc;		# SSRC of "this" Beacon
my $thisip;			# Reported IP address of "this" Beacon
my $thissortname;	# Sortname (Ie, "edu.uiuc.ncsa.jhereg|0x2ca1d510")
my $thishost;
my $thisuser;
my $starttime;		# Date format
my $timestarted;	# Epoch format
my $lasthistory;	# Last time history file was restarted

# Actual MOTD to show if $showmotd is set to one.  Set in  beacon.conf
my $MOTD;

# Default configuration file
my $CONFIGFILE = "/usr/pkg/etc/beacon.conf";

# For filenames to use for stats output history
my $HISTORYFILE		= "history.txt";		# Set it to the default value.
my $PREVHISTORYFILE	= "prevhistory.txt";	# Set it to the default value.

# Desired level of debug
my $DEBUG=0;	# defaults to "no debug"
my $debugfile = ">debug.txt";     # Debug file for output of debug
my $syslogFlag = 0;		# Enable syslogging (all STDOUT -> syslog)

# Testing flags
my $bursttest=0;	# Flag for periodic 100-packet burst test, default = no
my $silencetest =0;	# Flag for periodic three-minute silence test, def = no
my $BURSTTIME   =0;	# Epoch timestamp for next scheduled burst test
my $PREVBURSTTIME=0;	# Epoch timestamp for previous burst test
my $BURSTCOUNT	= 100;	# number of packets to transmit during burst test
# number of MICROseconds to pause between packets during burst test
my $BURSTSLEEP	= 10;	# 10 MICROseconds, not milliseconds

my $SILENCETIME = 0;# Epoch timestamp for next scheduled silence test
my $PREVSILENCETIME=0;# Epoch timestamp for previous silence test
my $SILENCEINTERVAL = 180;	# 3 minute (180 second) silence interval for test

my $TESTWINDOW		= 14400;	# 4 hours, or 240 minutes, or 14400 seconds

# Change to run as non-priveleged user
my $RUNASUSER;
my $RUNASGROUP;
my $userid;
my $groupid;


# Process ID file -- Contains PID of "this" instance of Beacon
my $beaconpidfile	= "multicastbeacon\.PID";

# End of DEFINES section
#
##-----------------------------------------------------------------------------




##-----------------------------------------------------------------------------
#
# get_opts		-   Command line / Config file handling occurs here
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------


sub get_opts() {

  open(CONFIGFILE, $CONFIGFILE) || 
	die ("CONFIGFILE open failed - \"$CONFIGFILE\"" );

  while (<CONFIGFILE>) {
    chomp;                  # no newline
    s/#.*//;                # no comments
    s/^\s+//;               # no leading white
    s/\s+$//;               # no trailing white
    next unless length;     # anything left?
    my ($var, $value) = split(/\s*=\s*/, $_, 2);
    $opts{$var} = $value;
  } 
  close(CONFIGFILE) || die ("Couldn't close CONFIGFILE" );

  foreach my $var (sort keys %opts) {

	if ($var eq "GROUP") {
		$GROUP = $opts{$var};
	} elsif ($var eq "PORT") {
		$PORT = $opts{$var};
	} elsif ($var eq "TTL") {
		$TTL = $opts{$var};
	} elsif ($var eq "NOSHUTDOWNMSG") {
		$noshutdownmsg = $opts{$var};
	} elsif ($var eq "SHOWREPORTS") {
		$showreports = $opts{$var};
	} elsif ($var eq "SHOWSSRC") {
		$showssrc = $opts{$var};
	} elsif ($var eq "SHOWIP") {
		$showip = $opts{$var};
	} elsif ($var eq "SHOWMOTD") {
		$showmotd = $opts{$var};
	} elsif ($var eq "MOTD") {
		$MOTD = $opts{$var};
	} elsif ($var eq "OUTPUTDIR") {
		$outputdir = $opts{$var};
	} elsif ($var eq "STOPME") {
		$stopme = $opts{$var};
	} elsif ($var eq "WRITEHISTORY") {
		$writehistory = $opts{$var};
	} elsif ($var eq "ERASEHISTORY") {
		$erasehistory = $opts{$var};
	} elsif ($var eq "CONTACTNAME") {
		$CONTACTNAME = $opts{$var};
	} elsif ($var eq "CONTACTINFO") {
		$CONTACTINFO = $opts{$var};
	} elsif ($var eq "CONTACTLOCATION") {
		$CONTACTLOCATION = $opts{$var};
	} elsif ($var eq "NOTIFYEMAIL") {
		$NOTIFYEMAIL = $opts{$var};
	} elsif ($var eq "CENTRALSERVERNAME") {
		$CENTRALSERVERNAME = lc($opts{$var});
	} elsif ($var eq "SERVERTCPPORT") {
		$SERVERTCPPORT = $opts{$var};
	} elsif ($var eq "BECENTRALSERVER") {
		$becentralserver = $opts{$var};
	} elsif ($var eq "SYSLOG") {
		$syslogFlag = $opts{$var};
	} elsif ($var eq "BURSTTEST") {
		$bursttest = $opts{$var};
	} elsif ($var eq "SILENCETEST") {
		$silencetest = $opts{$var};
	} elsif ($var eq "BACKGROUND") {
		$background = $opts{$var};
	} elsif ($var eq "INTERFACE") {
		$interface = $opts{$var};
	} elsif ($var eq "RUNASUSER") {
		$userid = $opts{$var};		# User to run as - Must be root to change
		if ($< != 0) {      # If not running as root ($< is UID)
			die "\n\nMust start as root to change UID. RUNASUSER = \"$userid\"";
		}
		$< = $> = getpwnam($userid) || die "Unable to get $userid: $!\n";
	} elsif ($var eq "RUNASGROUP") {
		$groupid = $opts{$var};
		$( = $) = getgrnam($groupid) || die "Unable to get $groupid: $!\n";
	} else {
		die ("Unknown option in config file \"$CONFIGFILE\" - \"$var\"");
	}
  }

# Get any command line options
  Getopt::Long::Configure ("bundling");   # Allow long and short args both
	# Using:		abcdefghijklmnoprstvqyz
	# Not Using:	qux
  GetOptions(   'background|a'	=> \$background,
	'becentralserver|b'		=> \$becentralserver,
	'centralservername|c=s'	=> \$CENTRALSERVERNAME,
	'debug|d=s'				=> \$DEBUG,
	'erasehistory|e'		=> \$erasehistory,
	'interface|f=s'			=> \$interface,
	'group|g=s'				=> \$GROUP,
	'help|h|?'				=> \$needs_help,
	'showip|i'				=> \$showip,
	'contactname|j=s'		=> \$CONTACTNAME,
	'contactinfo|k=s'		=> \$CONTACTINFO,
	'contactlocation|l=s'	=> \$CONTACTLOCATION,
	'notifyemail|m=s'		=> \$NOTIFYEMAIL,
	'noshutdownmsg|n'		=> \$noshutdownmsg,
	'outputdir|o=s'			=> \$outputdir,
	'port|p=s'				=> \$PORT,
	'syslog|q'				=> \$syslogFlag,
	'showreports|r'			=> \$showreports,
	'showssrc|s'			=> \$showssrc,
	'ttl|t=s'				=> \$TTL,
	'version|v'				=> \$showversion,
	'writehistory|w'		=> \$writehistory,
	'silencetest|y'			=> \$silencetest,
	'bursttest|z'			=> \$bursttest ) ||
	die ("Unknown option included in the command line, triggered" );

  tie( *STDOUT, 'Tie::Syslog','beacon','cons,pid','daemon' )
	if ( $syslogFlag );

  # Give the version information if they asked for it, or if sending to SysLog
  if ($showversion || $syslogFlag) {
	print "NLANR/DAST Multicast Beacon Version $VER-$SUBVER.\n";
	print "See http://dast.nlanr.net/projects/beacon for more info.\n";
	exit (0) if ( $showversion );
  }

  if ($needs_help) {			# Catch request for usage info first.
	print "\n";

	print "Examples:\n";

	print "\"./beacon\"\n";
	print "\tStarts Beacon using only settings from beacon.conf.\n";

	print "\"./beacon -o /home/beacon/outputfiles\"\n";
	print "\tSpecifies the directory to write output HTML and txt files to.\n";
	print "\tDon't specify a trailing slash.\n";

	print "\"./beacon --outputdir /home/beacon/outputfiles\"\n";
	print "\tSame as previous.\n";

	print "\"./beacon -n\"    or    \"./beacon --noshutdownmsg\"\n";
	print "\tDoes NOT write a shutdown message to HTML files when Beacon ";
	print "is shutdown.\n";

	print "\"./beacon -c beacon.ncsa.uiuc.edu\"\n";
	print "\tSpecifies the (optional) Central Server to send TCP ";
	print "reports back to.\n";

	print "\"./beacon --centralservername beacon.ncsa.uiuc.edu\"\n";
	print "\tSame as previous.\n";

	print "\"./beacon -i\"    or    \"./beacon --showip\"\n";
	print "\tShow Beacon IP addresses in the HTML output.\n";

	print "\"./beacon -r\"    or    \"./beacon --showreports\"\n";
	print "\tShow count of RRs during each interval in the HTML output.\n";

	print "\"./beacon -s\"    or    \"./beacon --showssrc\"\n";
	print "\tShow unique SSRC ID numbers for each Beacon in the HTML output.\n";

	print "\"./beacon -j\"    or    \"./beacon --contactname\"\n";
	print "\tSpecify Beacon contact's name on command line.\n";

	print "\"./beacon -k\"    or    \"./beacon --contactinfo\"\n";
	print "\tSpecify Beacon contact's info (email, phone, etc.) \n";
	print "\ton command line.\n";

	print "\"./beacon -l\"    or    \"./beacon --contactlocation\"\n";
	print "\tSpecify Beacon contact's physical location on command line.\n";

	print "\"./beacon -w\"    or    \"./beacon --writehistory\"\n";
	print "\tOutput statistics to CSV flat text file every 10 minutes.\n";
	print "\tHistory file name is \"history.txt\".\n";

	print "\"./beacon -e\"    or    \"./beacon --erasehistory\"\n";
	print "\tErase existing history file at startup.  If this option is\n";
	print "\tnot specified, output will be appended to the existing history \n";
	print "\tfile if there is one.\n";

	print "\"./beacon -y\"    or    \"./beacon --silencetest\"\n";
	print "\tEnables periodic Silence tests.\n";

	print "\"./beacon -z\"    or    \"./beacon --bursttest\"\n";
	print "\tEnables periodic Burst tests.\n";

	print "\"./beacon --notifyemail beaconadmin\@xyz.edu\"\n";
	print "\tSpecifies the email address to send alarm notifications to.\n";
	print "\tNot yet implemented.\n";

	print "\"./beacon -m beaconadmin\@xyz.edu\"\n";
	print "\tSame as previous.\n";

	print "\"./beacon -a\"    or    \"./beacon --background\"\n";
	print "\tCauses Beacon process to run in background at startup.\n";

	print "\"./beacon -f \"141.142.98.209\"\"\n";
	print "\tSpecifies which interface to use if more than one NIC \n";
	print "\tis present.\n";

	print "\"./beacon --interface \"141.142.98.209\"\"\n";
	print "\tSame as previous.\n";

	print "\"./beacon -g 233.4.200.19 -p 10002 -t 127\"\n";
	print "\tSpecifies group, port, and ttl on command line, instead\n";
	print "\tof using settings in beacon.conf.\n";

	print "\"./beacon --group 233.4.200.19 --port 10002 --ttl 127\"\n";
	print "\tSame as previous.\n";

	print "\"./beacon -b\" or \"./beacon.pl --becentralserver\"\n";
	print "\tAct as a Central Beacon Server.  Only one server is needed\n";
	print "\tfor multiple Beacons.  To participate with an existing Central\n";
	print "\tServer, you only need to run one Beacon that points to the \n";
	print "\texisting Central Server.\n";

	print "\"./beacon -d N\"    or    \"./beacon --debug N\"\n";
	print "\tSets debug level of Beacon script to integer N. Only 1 \n";
	print "\tand 2 are currently used.\n";

	print "\"./beacon -q\" \n";
	print "\tWrites STDOUT messages to the appropriate syslog file\n";
	print "\tin addition to STDOUT.\n";

	print "\"./beacon -v\"    or    \"./beacon --version\"\n";
	print "\tShows Beacon version information.\n";

	print "\"./beacon -h\"    or    \"./beacon --help\"\n";
	print "\tGives this message.\n";

	print "\nNLANR/DAST Multicast Beacon v$VER-$SUBVER\n";
	exit (0);
  }

  if (defined $stopme) {
	print "\n";
	print "\n";
	print "Hi -- Thanks for running Beacon $VER-$SUBVER!\n";
	print "Before you can run the Beacon, however, you'll need to edit file\n";
	print "beacon.conf and changes the settings there according to your\n";
	print "local installation.  Please be sure to add good contact \n";
	print "information for your local Beacon administrator, so we can \n";
	print "them in case something goes wrong with the Beacon, or in case\n";
	print "we need to contact them to let you know about a forced update\n";
	print "that's required to fix some particularly annoying bug.\n";
	print "\n";
	print "Also, please comment out the \"STOPME\" line at the bottom of\n";
	print "beacon.conf so you don't see this message anymore.  Thanks!\n";
	exit;
  }

  if ($GROUP eq "" || $PORT eq "" || $TTL eq "") {
	die("You must specify at least group, port, and ttl values - Triggered");
  }

  if (($PORT % 2) != 0) { 	# Chosen port must be *EVEN*, per RTP RFC 3550!
	die ("Initial PORT value must be *EVEN*, per the RTP spec in RFC3550 - Triggered"); 
  }

  if ((! defined $CONTACTINFO || ! defined $CONTACTNAME || ! defined $CONTACTLOCATION)  || ($CONTACTINFO eq "" || $CONTACTNAME eq "" || $CONTACTLOCATION eq "")) {
	print "\nHi -- Thanks for running the NLANR/DAST Beacon!\n";
	print "\n";
	print "Please set the CONTACTNAME, CONTACTINFO, and CONTACTLOCATION\n";
	print "information for whoever should be contacted about the Beacon";
	print "if there's a problem.\n";
	print "Beacon not started, pending inclusion of Contact Information.\n";
	print "\n";
	exit;
  }

  if (($CONTACTNAME =~ m/\|/) || ($CONTACTINFO =~ m/\|/) || ($CONTACTLOCATION =~m/\|/)) {
	print "Sorry -- CONTACTNAME, CONTACTINFO, and CONTACTLOCATION may not\n";
	print "contain the \"|\" character.  Please edit $CONFIGFILE and correct this.\n";
	exit;
  }

  if (! defined $outputdir) {
	print "Sorry -- You haven't specified an OUTPUTDIR to tell\n";
	print "me where to write the HTML and text files to.  Please\n";
	print "edit beacon.conf or specify one on the command line.\n";
	exit;
  }


	
  if (defined $NOTIFYEMAIL && $NOTIFYEMAIL =~ m/\|/) {
	print "Sorry -- NOTIFYEMAIL may not contain the \"|\" character.\n";
	print "Please edit $CONFIGFILE and correct this.\n";
	exit;
  }

  if ($showmotd && (! defined $MOTD)) {
	die ("You said you wanted to show the MOTD, but no MOTD is defined - "); 
  }

  # They didn't specify a custom port for TCP Unicast reports, so 
  # use the default value of PORT+2. 
  if (! defined $SERVERTCPPORT) {
	# This is the normal, default behavior -- Don't set a custom port 
	# for this unless you KNOW you need to.
	$SERVERTCPPORT = $PORT + 2;
  }

  if ($becentralserver && (! defined $CENTRALSERVERNAME)) {
	print "You haven't specified the name of the central server for me to\n";
	print "send TCP reports back to.  Please specify CENTRALSERVERNAME\n";
	print "in beacon.conf or via command line switch.\n";
	exit;
  }

  # Set RTCP_PORT so we can show it on web page, defaults to $PORT+1
  $RTCP_PORT	= $PORT+1;
  if ($DEBUG > 0) {
	  print "Setting RTCP_PORT, PORT = $PORT\n";
  }

} # get_opts



##-----------------------------------------------------------------------------
#
# html_output	- Generates output HTML pages
#
# Takes		- Name of file to generate, values for green/yellow/red table cells,
#			  pointers for which ssrc, ip, sortname, report count, and stats 
#			  hash tables to use for this output pass
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub html_output {
  # Get name for this pass, as well as values for green/yellow/red table cells
  my $thispass	= shift(@_);
  my $greenval	= shift(@_);		
  my $yellowval	= shift(@_);
  my $redval	= shift(@_);	

  my $ssrc_lookup	= shift(@_);
  my $ip_lookup		= shift(@_);
  my $sort_lookup	= shift(@_);
  my $reports		= shift(@_);

  my $stats			= shift(@_);

  my $value;							# Value to be written to table cell 

  my ($s_ssrc, $r_ssrc);				# For walking the matrix/table
  my ($outer, $inner);					# Strings for names for sort

  # How many Beacons?
  my $totalbeacons;
  if (defined $totalblind) {
	$totalbeacons	= scalar(keys( %$ssrc_lookup)) - $totalblind;
	# DEBUG
	#print "Totalbeacons = $totalbeacons, totalblind = $totalblind\n";
	# END DEBUG
  } else {
	$totalbeacons	= scalar(keys( %$ssrc_lookup));
  }

  my $dd;						# index var for looping
  my $ii;						# index var for looping
  my @bold;						# Array for bolding routine
  my $alpha;			# "Alpha chars or numerics?" flag for bolding routine

  my $COLHEADERS	= 10;		# Insert a line of column headers every N rows.
  my $ROWHEADERS	= 10;		# Insert a line of row headers every N columns.
  
  my $CELLWIDTH		= 40;		# How wide are the table cells?
  my $CELLHEIGHT	= 16;		# And how tall are they?
  
  my $nodatacolor	= "Gray";	# Color of cell if no data is available
  
  # Web page output color values
  # Color to use for highlighting "me" in the list of Beacons
  my $mybeacon_color	= "green";

  my $color;							# For color assignment
  
  # Open the temporary outfile where we'll be writing HTML data to 
  # prior to swapping it into the real file....
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";
  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";
  
  open(OUTFILE, $outfile2) || die ("OUTFILE open failed" );
  
  # Build the top of the output file
  # Beacons to show, Name of page, and "Show Blind?" flag
  html_header($totalbeacons, $thispass, 1);

#--------- end top part ----


  # Count the Beacons - "AH AH AH AHHHHHHHH!"
  my $linecount = 0;
  my $beacon_marker = -1;

OUTER:  foreach $outer (sort keys %$ssrc_lookup) {
	$s_ssrc = $$ssrc_lookup{$outer};

	if ($blind{$s_ssrc}) {
		next OUTER;
	}

#--------- start outer loop part ----

  	# Just the headers 
	# How often to put in headers = $linecount modulo COLHEADERS
	if ($linecount%$COLHEADERS == 0) {
		# HEADERS - Print the row of sender headers across top
		print OUTFILE "<TR bgcolor=\"lightblue\">\n";
		print OUTFILE " <TH>#</TH>\n";

		print OUTFILE " <TH NOWRAP>Hostname</TH>\n";

		# Show IP addresses
		if ($showip) {
			print OUTFILE " <TH>IP Address</TH>\n";
		}

		# Show SSRC
		if ($showssrc) {
			print OUTFILE " <TH>SSRC</TH>\n";
		}

		# Show RR Report count
		if ($showreports) {
			print OUTFILE " <TH>RRs</TH>\n";
		}

		for ($dd=0; $dd<$totalbeacons; $dd++) {
			print OUTFILE " <TH>S$dd</TH>\n";
			# How often to put in headers = $linecount modulo ROWHEADERS
			if (($dd+1)%$ROWHEADERS == 0) {
				# Hold the space in the table for the row headers
				print OUTFILE " <TD>&nbsp;</TD>\n";
			}
		}
		print OUTFILE "</TR>\n";
	}
  
	print OUTFILE "<TR>\n";
  
	# Now print this row for Receivers
	# This is *this* Beacon (ie, "me") in the table.  Mark it w/ diff color
	if ($thisssrc == $s_ssrc) {
		print OUTFILE "\n <TD NOWRAP bgcolor=\"$mybeacon_color\" ";
		print OUTFILE "ALIGN=\"center\"><B>R$linecount</B></TD>\n";
		$beacon_marker = $linecount;	# Mark the "*This* Beacon" line
	} else {
		print OUTFILE "\n <TD NOWRAP bgcolor=\"#CCCCFF\" ";
		print OUTFILE "ALIGN=\"center\"><B>R$linecount</B></TD>\n";
	}
  
  	# Two columns for hostname/IP, hostname right justified, IP left justified.

	print OUTFILE " <TD NOWRAP bgcolor=\"#CCCCFF\" align=\"right\">";
  
  	# Bold the last two chunks of the hostname if more than one chunk long
	# Separate name from ssrc - "edu.uiuc.ncsa.yendi|0x3b02639a"
	my @parts = split /\|/, $$sort_lookup{$s_ssrc};
  	# Just reverse and bold the name itself.
  	@bold = split /\./, $parts[0];
  
  	# letters in name, or just numbers? (Ie, raw IP as 
	# "name") "$alpha = 1" = letters, else numbers only
	for ($ii=$#bold; $ii>=0; $ii--) {
		$alpha = ($bold[$ii] =~ /[a-z]/);
	}
  
	# How many dots did we find?  Two or more dots means three or more 
	# pieces to name
	if ($#bold > 1) {
		for ($dd=$#bold; $dd>=0; $dd--) {	# Get each Beacon's data
			# bottom or next-to-bottom pieces - Bold letters
			if ($dd < 2 && $alpha) {
				print OUTFILE "<b>$bold[$dd]</b>";	
			# This is the line that prints for "$alpha != 1".  Just print #'s
			} else {
				print OUTFILE "$bold[$dd]";	
			}
  			if ($dd > 0 ) {
				print OUTFILE ".";	
			}
		}

	} else {

		if (lc($bold[0]) eq "localhost") {
			print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/";
			print OUTFILE "beaconfaq.html#localhost\">@bold</a>";

		} else {
			print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/";
			print OUTFILE "beaconfaq.html#hostname\">@bold</a>";
		}
	}

	print OUTFILE "</TD>\n";
  
	# Show the reverse-lookuped IP address
	if ($showip) {
		print OUTFILE " <TD NOWRAP bgcolor=\"#CCCCFF\" align=\"left\">";
		if (defined $$ip_lookup{$s_ssrc}) {
			if (($$ip_lookup{$s_ssrc} =~ m/^192\.168/) || 
				($$ip_lookup{$s_ssrc} =~ m/^10\.1/)) {
				print OUTFILE "NAT'd Address";
			} elsif ($$ip_lookup{$s_ssrc} =~ m/^127\.0\.0/) {
				print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/beaconfaq.html#localhost\">Localhost</a>";
			} elsif ($$ip_lookup{$s_ssrc} eq "UNKN") {
				print OUTFILE "Unresolvable";
			} else {
				print OUTFILE "$$ip_lookup{$s_ssrc}";
			}
		} else {
			print "No IP yet.\n";
		}
		print OUTFILE "</TD>\n";
	}

	# Show the SSRC in hex
	if ($showssrc) {
		print OUTFILE " <TD NOWRAP bgcolor=\"#CCCCFF\" align=\"left\">";
		printf OUTFILE "<font face=\"courier\">0x%08x</font>", $s_ssrc;
		print OUTFILE "</TD>\n";
	}

	# Show SR report count
	if ($showreports) {
		print OUTFILE " <TD NOWRAP bgcolor=\"#CCCCFF\" align=\"right\">";
		if (defined $$reports{$s_ssrc}) {
			if ($$reports{$s_ssrc} == -1) {
				print OUTFILE "NA";
			} else {
				print OUTFILE "$$reports{$s_ssrc}";
			}
		} else {
			print OUTFILE "None";
		}
		print OUTFILE "</TD>\n";
	}


#--------- end outer loop part ----

	my $innercount = 1;	# Counter for the inner loop...
INNER:	foreach $inner (sort keys %$ssrc_lookup) {
		$r_ssrc = $$ssrc_lookup{$inner};

		if ($blind{$r_ssrc}) {
			next INNER;
		}

		# Set the datatype we're reporting on here
		my $datatype;
		if ($thispass eq "fract_lost") {
			$datatype = $FRACT_LOST;
		} elsif ($thispass eq "local_loss" || $thispass eq "central_loss") {
			$datatype = $TOTAL_LOST;
		} elsif ($thispass eq "local_rtt" || $thispass eq "central_rtt") {
			$datatype = $RTT;
		} elsif ($thispass eq "local_jitter" || $thispass eq "central_jitter") {
			$datatype = $JITTER;
		}

		# Retrieve and output current legitimate values
		if (defined $$stats{$s_ssrc}{$r_ssrc}[$datatype]) {
			$value	= $$stats{$s_ssrc}{$r_ssrc}[$datatype];
		} else {
			$value = -1;	# NA value
		}

		if ($thispass eq "local_loss" || $thispass eq "central_loss") {

		    $value = &get_loss($stats, $s_ssrc, $r_ssrc, $thispass);

			# Record it for the history output
			$$stats{$s_ssrc}{$r_ssrc}[$INTERVAL_LOSS] = $value;

		} elsif ($thispass eq "local_rtt" || $thispass eq "central_rtt") {
			# Calculate current RTT
			if (defined $$stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL] &&
					defined $$stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT]) {
				$value = int($$stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL] / 
					$$stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT]);

				# Clear for next pass
				undef $$stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL];
				undef $$stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT];

			} else {
				$value = -1;
			}
		}

		# Now generate some output!
		$color = "lightgreen";
		if (($value > $greenval) && ($value <= $yellowval)) {$color = "yellow";}
		if (($value > $yellowval) && ($value <= $redval)) {$color = "red";}
		if ( $value > $redval || $value < 0) {$color = "lightgrey";}

		if ($value > $redval) {		# Bogus value
			print OUTFILE " <TD NOWRAP ALIGN=\"right\" ";
			print OUTFILE "bgcolor=\"$color\">";
			print OUTFILE "**";
			#print OUTFILE "$value";
		} elsif ($value == -1) {	# NA value - Show a grey "NA"
			print OUTFILE " <TD NOWRAP ALIGN=\"center\" ";
			print OUTFILE "bgcolor=\"$color\">";
			print OUTFILE "NA";
		} elsif ($value < -1) {	# Odd negative value
			print OUTFILE " <TD NOWRAP ALIGN=\"center\" ";
			print OUTFILE "bgcolor=\"$color\">";
			print OUTFILE "*";
		} else {					# Normal case -- Show good value
			print OUTFILE " <TD NOWRAP ALIGN=\"right\" ";
			print OUTFILE "bgcolor=\"$color\">";
			print OUTFILE "$value";
		}
		print OUTFILE "</TD>\n";

		# Column headers go here
		# How often to put in headers = $linecount modulo ROWHEADERS
		if (($innercount)%$ROWHEADERS == 0) {
			# This is *this* Beacon in the table.  Mark w/ diff color
			if ($linecount == $beacon_marker && $beacon_marker > -1) {
				print OUTFILE "\n <TD NOWRAP bgcolor=\"$mybeacon_color\" ";
				print OUTFILE "ALIGN=\"center\"><B>R$linecount</B></TD>\n";
			} else {
				print OUTFILE "\n <TD NOWRAP bgcolor=\"#CCCCFF\" ";
				print OUTFILE "ALIGN=\"center\"><B>R$linecount</B></TD>\n";
			}
  
		}

		$innercount++;

	}

	$linecount++;
	print OUTFILE "</TR>\n";

  }

#--------- start bottom part ----

  html_footer($thispass, $greenval, $yellowval, $redval);

  close(OUTFILE) || die ("Couldn't close HTML OUTFILE \"$outfile\"" );
        
  # Swap the temp file into the real file.  "*Whump*!"
  rename "$outfile", $outputdir . "/" . $thispass . "\.html" || 
		die ("Couldn't rename OUTFILE $outputdir/$outfile to $thispass . \".html\"" );

#--------- end bottom part ----

  return;
} # html_output




##-----------------------------------------------------------------------------
#
# html_prefilter	- Pre-filter prior to HTML output to generate list of
#					  Beacon that only see themselves and are only seen by 
#					  themselves.
#
# Takes		- Pointers for which ssrc lookup and stats hash tables to use
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub html_prefilter {
  # Get name for this pass, as well as values for green/yellow/red table cells

  my $ssrc_lookup	= shift(@_);
  my $host_lookup	= shift(@_);
  my $stats			= shift(@_);

  my $value;							# Value to be written to table cell 

  my ($s_ssrc, $r_ssrc);				# For walking the matrix/table
  my ($outer, $inner);					# Strings for names for sort

  undef %blind;				# Reset for continuously changing # of Beacons

  # Prepare the hash that says if a Beacon is blind or not
  foreach $outer (sort keys %$ssrc_lookup) {
	$s_ssrc = $$ssrc_lookup{$outer};
	$blind{$s_ssrc} = 1;		# Default to assuming all Beacons blind
  }

  $totalblind = 0;				# Assume no blind Beacons this pass

  # Count the Beacons - "AH AH AH AHHHHHHHH!"
  foreach $outer (sort keys %$ssrc_lookup) {
	$s_ssrc = $$ssrc_lookup{$outer};

	foreach $inner (sort keys %$ssrc_lookup) {
		$r_ssrc = $$ssrc_lookup{$inner};

	    $value = -1;			# Default --  Assume no data for this Beacon

	    if (defined $$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ] && 
			defined $$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST]) {

			if (defined $$stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ] && 
				defined $$stats{$s_ssrc}{$r_ssrc}[$PREV_LOST]) { 

			    my $expected = $$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ] - 
					$$stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ];
			    my $lost = $$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST] - 
					$$stats{$s_ssrc}{$r_ssrc}[$PREV_LOST];

			    if ($expected) {
			       	$value = int(( $lost / $expected ) * 100);
					if ($value < 0 ) {
						$value = 0;
					}
			    } else {
					$value = 0;
			    }

			}

		}

		# Actual data for this Beacon, & not referring to itself - Ie, Not blind
		if (($value != -1) && ($s_ssrc != $r_ssrc)) {
			$blind{$s_ssrc} = 0;
		}

        ## DEBUG  - Mark "issola" as blind for testing purposes
        #print "LOOKUP - \"$$host_lookup{$s_ssrc}\"\n";
		#if ($$host_lookup{$s_ssrc} eq "issola.ncsa.uiuc.edu") {
		#	$blind{$s_ssrc} = 1;
		#}
		#	
        # END DEBUG
  


	}

  }

  # Count up total number of blind Beacons
  foreach $outer (sort keys %$ssrc_lookup) {
	$s_ssrc = $$ssrc_lookup{$outer};

	if ($blind{$s_ssrc}) {		# Blind Beacon
		$totalblind ++;			# Increment blind Beacon count
	}
  }

  return;
} # html_prefilter



##-----------------------------------------------------------------------------
#
# beacon_info_output	- Generates Beacon info HTML page.  Only for TCP side.
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub beacon_info_output() {

  my $totalbeacons	= scalar(keys( %tcp_ssrc_lookup));	# How many Beacons?
  my $thispass = "beacon_info";

  # Open the temporary outfile where we'll be writing HTML data to 
  # prior to swapping it into the real file....
  #my $outfile = $thispass . "\.TEMP";			# For -rename- at end of file.
  #my $outfile2 = ">" . $thispass . "\.TEMP";	# For the -OPEN- right here.

  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";
  
  open(OUTFILE, $outfile2) || die ("OUTFILE open failed" );
  
  # Beacons to show, Name of page, and "Show Blind?" flag
  html_header($totalbeacons, $thispass, 1);

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


  my $dd;						# index var for looping
  my $ii;						# index var for looping
  my @bold;						# Array for bolding routine
  my $alpha;	# "Alpha chars or numerics?" flag for bolding routine

  print OUTFILE "<TABLE BORDER=\"1\">\n";

#--------- end top part ----

  print OUTFILE "<TR bgcolor=\"lightblue\">\n";
  print OUTFILE " <TH nowrap>#</TH>\n";
  print OUTFILE " <TH nowrap>Hostname</TH>\n";
  print OUTFILE " <TH nowrap>IP Address</TH>\n";
  print OUTFILE " <TH nowrap>SSRC</TH>\n";
  print OUTFILE " <TH nowrap>User</TH>\n";
  print OUTFILE " <TH nowrap>OS</TH>\n";
  print OUTFILE " <TH nowrap>Uptime</TH>\n";
  print OUTFILE " <TH nowrap>Started</TH>\n";
  print OUTFILE " <TH nowrap>Last Heard</TH>\n";
  print OUTFILE " <TH nowrap>Contact Name</TH>\n";
  print OUTFILE " <TH nowrap>Contact Info</TH>\n";
  print OUTFILE " <TH nowrap>Contact Location</TH>\n";
  print OUTFILE " <TH nowrap>Next Burst Test</TH>\n";
  print OUTFILE " <TH nowrap>Next Silence Test</TH>\n";
  print OUTFILE " <TH nowrap>Prev Burst Test</TH>\n";
  print OUTFILE " <TH nowrap>Prev Silence Test</TH>\n";

  print OUTFILE "</TR>\n";
  
################
# LOOP STARTS HERE.....
################

  my $host;
  my $hostnum=0;	# How many hosts do we have so far?
  my $bgcolor;
  my $namecolor = "#CCCCFF";
  foreach $host (sort keys %tcp_ssrc_lookup) {

	if ($hostnum % 2 == 0) {
	  	$bgcolor = "lightgreen";
	} else {
		$bgcolor = "lightblue";
	}

	my $ssrc = $tcp_ssrc_lookup{$host};

	print OUTFILE "<TR>\n";

	# Visually (no pun intended) mark Blind Beacons
	if ($blind{$ssrc}) {
		print OUTFILE " <TD bgcolor=\"blue\" ";
		print OUTFILE "align=\"left\"><font color=\"white\"><b>B$hostnum</b>";
		print OUTFILE "</TD>";
	} else {
		print OUTFILE " <TD bgcolor=\"$bgcolor\" ";
		print OUTFILE "align=\"left\"><b>B$hostnum</b>";
		print OUTFILE "</TD>";
	}

  	# Two columns for hostname/IP, hostname right justified, IP left justified.

	print OUTFILE " <TD NOWRAP bgcolor=\"$namecolor\" align=\"right\">";
  
  	# Bold the last two chunks of the hostname if more than one chunk long
	# Separate name from ssrc - "edu.uiuc.ncsa.yendi|0x3b02639a"
	my @parts = split /\|/, $tcp_sort_lookup{$ssrc};
  	# Just reverse and bold the name itself.
  	@bold = split /\./, $parts[0];
  
  	# letters in name, or just numbers? (Ie, raw IP as 
	# "name") "$alpha = 1" = letters, else numbers only
	for ($ii=$#bold; $ii>=0; $ii--) {
		$alpha = ($bold[$ii] =~ /[a-z]/);
	}
  
	# How many dots did we find?  Two or more dots means three or more 
	# pieces to name
	if ($#bold > 1) {
		for ($dd=$#bold; $dd>=0; $dd--) {	# Get each Beacon's data
			# bottom or next-to-bottom pieces - Bold letters
			if ($dd < 2 && $alpha) {
				print OUTFILE "<b>$bold[$dd]</b>";	
			# This is the line that prints for "$alpha != 1".  Just print #'s
			} else {
				print OUTFILE "$bold[$dd]";	
			}
  			if ($dd > 0 ) {
				print OUTFILE ".";	
			}
		}

	} else {

		if (lc($bold[0]) eq "localhost") {
			print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/";
			print OUTFILE "beaconfaq.html#localhost\">@bold</a>";

		} else {
			print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/";
			print OUTFILE "beaconfaq.html#hostname\">@bold</a>";
		}
	}

	print OUTFILE "</TD>\n";
  
	# Show the reverse-lookuped IP address
	if ($showip) {
		print OUTFILE " <TD NOWRAP bgcolor=\"$namecolor\" align=\"left\">";
		if (defined $tcp_ip_lookup{$ssrc}) {
			if (($tcp_ip_lookup{$ssrc} =~ m/^192\.168/) || 
				($tcp_ip_lookup{$ssrc} =~ m/^10\.1/)) {
				print OUTFILE "NAT'd Address";
			} elsif ($tcp_ip_lookup{$ssrc} =~ m/^127\.0\.0/) {
				print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/beaconfaq.html#localhost\">Localhost</a>";
			} else {
				print OUTFILE "$tcp_ip_lookup{$ssrc}";
			}
		} else {
			print "No IP yet.\n";
		}
		print OUTFILE "</TD>\n";
	}

	# Show the SSRC in hex
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	printf OUTFILE "<font face=\"courier\">0x%08x</font>", $ssrc;
	print OUTFILE "</TD>\n";

	# Show SR report count
	#if ($showreports) {
	#	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"right\">";
	#	if (defined $tcp_reports{$ssrc}) {
	#		print OUTFILE "$tcp_reports{$ssrc}";
	#	} else {
	#		print OUTFILE "None";
	#	}
	#	print OUTFILE "</TD>\n";
	#}

	# User
	if ($tcp_meta{$ssrc}[$USER] eq "root") {	# Running the Beacon as root!
		print OUTFILE " <TD NOWRAP bgcolor=\"red\" align=\"left\">";
		print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/beaconfaq.html#root\">$tcp_meta{$ssrc}[$USER]</a>";
	} else {
		print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
		print OUTFILE "$tcp_meta{$ssrc}[$USER]";
	}
	print OUTFILE "</TD>\n";

	# Show the  OS
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	print OUTFILE "$tcp_meta{$ssrc}[$OS]";
	print OUTFILE "</TD>\n";

	# Show the  Perl Version
	#print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	#print OUTFILE "$tcp_meta{$ssrc}[$PERLVER]";
	#print OUTFILE "</TD>\n";

	# Show the uptime
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"right\">";
	my $now = time;		# "Now" in Epoch Seconds

	if ($now <= $tcp_meta{$ssrc}[$START]) {
		print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/";
		print OUTFILE "beaconfaq.html#ntp\">Bad Clock</a>";
	} else {

		my $difference = $now - $tcp_meta{$ssrc}[$START];
		my $seconds    =  int($difference % 60);
		$difference = ($difference - $seconds) / 60;
		my $minutes    =  int($difference % 60);
		$difference = ($difference - $minutes) / 60;
		my $hours      =  int($difference % 24);
		$difference = ($difference - $hours)   / 24;
		my $days       =  int($difference % 7);
#		my $weeks      = int(($difference - $days)    /  7);
		$difference =  ($difference - $days) / 7;	# MITCH
		my $weeks      =  int($difference % 4);		# MITCH
		if ($weeks) { print OUTFILE "$weeks w "; }
		if ($days) { print OUTFILE "$days d "; }
		if ($hours) { print OUTFILE "$hours h "; }
		if ($weeks == 0) {
			print OUTFILE "$minutes m ";
			if ($days == 0) {
				print OUTFILE "$seconds s";
			}
		}

	}
	print OUTFILE "</TD>\n";

	# Show when started
	my $started = &ctime($tcp_meta{$ssrc}[$START]);
	chomp $started;
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"right\">";
	print OUTFILE "$started";
	print OUTFILE "</TD>\n";

	# Show when last heard from
	my $lastheard = &ctime($tcp_meta{$ssrc}[$LAST_HEARD]);
	chomp $lastheard;
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"right\">";
	print OUTFILE "$lastheard";
	print OUTFILE "</TD>\n";

	# Contact Name
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	print OUTFILE "$tcp_meta{$ssrc}[$NAME]";
	print OUTFILE "</TD>\n";

	# Contact Info
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	print OUTFILE "$tcp_meta{$ssrc}[$INFO]";
	print OUTFILE "</TD>\n";

	# Contact Loc
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	print OUTFILE "$tcp_meta{$ssrc}[$LOC]";
	print OUTFILE "</TD>\n";

	my $temp;		# For testinfo fields

	# Next Burst Test
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	if ($tcp_meta{$ssrc}[$BTEST] == -1) {
		$temp = "Testing Turned Off";
	} else {
		$temp = &ctime($tcp_meta{$ssrc}[$BTEST]);
	}
	print OUTFILE "$temp";
	print OUTFILE "</TD>\n";

	# Next Silence Test
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	if ($tcp_meta{$ssrc}[$STEST] == -1) {
		$temp = "Testing Turned Off";
	} else {
		$temp = &ctime($tcp_meta{$ssrc}[$STEST]);
	}
	print OUTFILE "$temp";
	print OUTFILE "</TD>\n";

	# Previous Burst Test
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	if ($tcp_meta{$ssrc}[$PBTEST] == -1) {
		$temp = "Testing Turned Off";
	} elsif ($tcp_meta{$ssrc}[$PBTEST] == 0) {
		$temp = "Still Pending";
	} else {
		$temp = &ctime($tcp_meta{$ssrc}[$PBTEST]);
	}
	print OUTFILE "$temp";
	print OUTFILE "</TD>\n";

	# Previous Silence Test
	print OUTFILE " <TD NOWRAP bgcolor=\"$bgcolor\" align=\"left\">";
	if ($tcp_meta{$ssrc}[$PSTEST] == -1) {
		$temp = "Testing Turned Off";
	} elsif ($tcp_meta{$ssrc}[$PSTEST] == 0) {
		$temp = "Still Pending";
	} else {
		$temp = &ctime($tcp_meta{$ssrc}[$PSTEST]);
	}
	print OUTFILE "$temp";
	print OUTFILE "</TD>\n";

#--------- end outer loop part ----
	print OUTFILE "</TR>\n";

	$hostnum++;
  }

#--------- start bottom part ----

  print OUTFILE "</TABLE>\n";
  print OUTFILE "\n\n";

  print OUTFILE "<P>\n\n";
  print OUTFILE "<b>* Note: Hostnames are displayed alphabetically ";
  print OUTFILE "by <i>reverse</i> domain name.</b><br>\n";
  print OUTFILE "<b>* Note: <i>Started</i> and <i>Uptime</i> columns ";
  print OUTFILE "assume an accurate local clock.</b><P>\n";
        
  if ($totalblind) {	# If there are blind beacons present
		print OUTFILE "<P>\n\n";
		print OUTFILE "<b>* Note: Beacons marked with a white number on a ";
		print OUTFILE "blue background are  \"Blind Beacons\".</b><p>\n";
  }

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

  html_footer($thispass, 0, 0, 0);

  close(OUTFILE) || die ("Couldn't close HTML OUTFILE \"$outfile\"" );
        
  # Swap the temp file into the real file.  "*Whump*!"
  #rename "$outfile", $thispass . "\.html" || 
  rename "$outfile", $outputdir . "/" . $thispass . "\.html" || 
		die ("Couldn't rename OUTFILE $outfile to $thispass . \".html\"" );

} # beacon_info_output


##-----------------------------------------------------------------------------
#
# html_update_local	- Build the top part of the HTML output file
#
# Takes:        $totalbeacons	- Count of current number of Beacons
#				$thispass		- Name of this page
# 				$showblind		- Do we show Blind Beacons on this page?
# Returns:      Nothing
#
#
##-----------------------------------------------------------------------------

sub html_update_local() {

	# Update the central server HTML page, if we're the central server
	# Send reports back to the central server, if configured for that
	# NOTE: This must be done before the calls below to html_output, because
	# html_output will clear RTT_COUNT and RTT_TOTAL for the next interval

	# Update the web pages
	&html_output("fract_lost", 10, 30, 100, \%ssrc_lookup, \%ip_lookup, \%sort_lookup, \%reports, \%stats);
	&html_output("local_loss", 10, 30, 100, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);
	&html_output("local_rtt", 100, 500, 5000, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);
	&html_output("local_jitter", 200, 250, 500, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);


	# Clear report counters for next pass
	undef %reports;

	&host_lookup_output(\%host_lookup, "host_lookup");
	&sort_lookup_output(\%sort_lookup, "sort_lookup");
	&ip_lookup_output(\%ip_lookup, "ip_lookup");
	&ssrc_lookup_output(\%ssrc_lookup, "ssrc_lookup");
	&stats_table_output(\%stats, \%host_lookup, "stats_lookup");

}


##-----------------------------------------------------------------------------
#
# html_update_central	- Build the top part of the HTML output file
#
# Takes:        $totalbeacons	- Count of current number of Beacons
#				$thispass		- Name of this page
# 				$showblind		- Do we show Blind Beacons on this page?
# Returns:      Nothing
#
#
##-----------------------------------------------------------------------------

sub html_update_central() {

	# Update the central server HTML page, if we're the central server
	# Send reports back to the central server, if configured for that
	# NOTE: This must be done before the calls below to html_output, because 
	# XXX html_output will clear RTT_COUNT and RTT_TOTAL for the next interval
#	if (defined $CENTRALSERVERNAME) {
#		&send_central_report();
#	}

	# Update the web pages
    &html_prefilter(\%tcp_ssrc_lookup, \%tcp_host_lookup, \%tcp_stats);
    &html_output("central_loss", 10, 30, 100, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);
    &html_output("central_rtt", 100, 500, 5000, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);
    &html_output("central_jitter", 200, 250, 500, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);

#		if ( $DEBUG > 0 ) {
#			&contactinfo_output();
#		}

#    &beacon_info_output();

# They want history output
#    if ($writehistory) {
#	&history_output();		# Generate flast-text CSV of stats
#    }

# Clear report counters for next pass
    undef %tcp_reports;

    &host_lookup_output(\%tcp_host_lookup, "tcp_host_lookup");
    &sort_lookup_output(\%tcp_sort_lookup, "tcp_sort_lookup");
    &ip_lookup_output(\%tcp_ip_lookup, "tcp_ip_lookup");
    &ssrc_lookup_output(\%tcp_ssrc_lookup, "tcp_ssrc_lookup");
    &stats_table_output(\%tcp_stats, \%tcp_host_lookup, "tcp_stats_lookup");

} # html_update_central

##-----------------------------------------------------------------------------
#
# html_header	- Build the top part of the HTML output file
#
# Takes:        $totalbeacons	- Count of current number of Beacons
#				$thispass		- Name of this page
# 				$showblind		- Do we show Blind Beacons on this page?
# Returns:      Nothing
#
#
##-----------------------------------------------------------------------------

sub html_header() {
  my $totalbeacons	= shift(@_);
  my $thispass		= shift(@_);
  my $showblind		= shift(@_);
  my $datetemp = &ctime(time);		# Get the current time
  chop $datetemp;					# Remove trailing line return
  

  # Start the HTML file
  print OUTFILE "<HTML>\n<HEAD>\n";
  print OUTFILE "  <TITLE>NLANR/DAST Beacon Webview on $datetemp</TITLE>\n";
  print OUTFILE "  <META HTTP-EQUIV=\"REFRESH\" CONTENT=\"$WEBREFRESH\">\n";
  print OUTFILE "</HEAD>\n\n<BODY>\n";
  print OUTFILE "<TABLE WIDTH=\"100%\">\n <TR>\n";
  print OUTFILE "  <TD NOWRAP ALIGN=\"BOTTOM\">\n";
  print OUTFILE "   <FONT SIZE=\"5\">";
  print OUTFILE "<B><a href=\"http://dast.nlanr.net/projects/beacon/\">";
  print OUTFILE "Multicast Beacon</a></B>";
  print OUTFILE "</FONT>\n";
  print OUTFILE "   <FONT SIZE=\"2\">v$VER-$SUBVER</FONT>\n";

  print OUTFILE "<FONT SIZE=\"4\">&nbsp;&nbsp;<b>This page is showing: \n";
  if ($thispass eq "central_loss") {
	print OUTFILE "Central Loss (%)";
  } elsif ($thispass eq "local_loss") {
	print OUTFILE "Local Loss (%)";
  } elsif ($thispass eq "fract_lost") {
	print OUTFILE "Fractional Loss (%)";
  } elsif ($thispass eq "central_rtt") {
	print OUTFILE "Central Round Trip Time (ms)";
  } elsif ($thispass eq "local_rtt") {
	print OUTFILE "Local Round Trip Time (ms)";
  } elsif ($thispass eq "local_jitter") {
	print OUTFILE "Local Jitter (%)";
  } elsif ($thispass eq "central_jitter") {
	print OUTFILE "Central Jitter (%)";
  } elsif ($thispass eq "beacon_info") {
	print OUTFILE "Beacon Information";
  }
  print OUTFILE "</b></FONT><br>\n";

  print OUTFILE "  </TD>\n  <TD>\n";
  print OUTFILE "  </TD>\n";
  print OUTFILE " </TR>\n</TABLE>\n";
  
  # Write the links to the other files
  print OUTFILE "<P>\n\n";
  
  if ($showmotd) {					# Show the MOTD if flagged
  	print OUTFILE "<p>\n\n<b>$MOTD</b><p>";
  }
  
  # Write the general information about this particular BeaconServer session
  print OUTFILE "Time: <B>$datetemp CST</B> | ";
  print OUTFILE "Page Refresh: <B>$WEBREFRESH seconds</B> | ";
  print OUTFILE "Started: $starttime | ";
  if ($showblind && $becentralserver && $totalblind) {
	print OUTFILE "Beacons: <B>$totalbeacons</B> | ";
	print OUTFILE "<a href=\"#blind\">Blind Beacons</a>: <B>$totalblind</B><BR>\n";
  } else {
	print OUTFILE "Beacons: <B>$totalbeacons</B><BR>";
  }
  print OUTFILE "Target Multicast Group: <B>$GROUP</B> | ";
  print OUTFILE "Client-to-Client (RTP) multicast traffic on ";
  print OUTFILE "port: <B>$PORT</B>, ";
  print OUTFILE "RTCP traffic on port: $RTCP_PORT\n";
  if ($CENTRALSERVERNAME) {
	print OUTFILE "<br>TCP unicast reports going back to the Central ";
	print OUTFILE "Server on port $SERVERTCPPORT\n";
  }

  print OUTFILE "<P>\n\n";

  print OUTFILE "<a href=\"central_loss.html\">Central Loss</a> | ";
  print OUTFILE "<a href=\"local_loss.html\">Local Loss</a> | ";
  print OUTFILE "<a href=\"fract_lost.html\">Fract Loss</a> | ";
  print OUTFILE "<a href=\"central_rtt.html\">Central RTT</a> | ";
  print OUTFILE "<a href=\"local_rtt.html\">Local RTT</a> | ";
  print OUTFILE "<a href=\"central_jitter.html\">Central Jitter</a> | ";
  print OUTFILE "<a href=\"local_jitter.html\">Local Jitter</a> | ";
  print OUTFILE "<a href=\"beacon_info.html\">Beacon Info</a>";

  if ($writehistory) {
	print OUTFILE " | ";
#	print OUTFILE "<a href=\"history.txt\">$HSECS-second History</a> | ";
	print OUTFILE "<a href=\"history.txt\">History</a> | ";
	print OUTFILE "<a href=\"prevhistory.txt\">Previous History</a>";
  }
  print OUTFILE "<p>\n";

  print OUTFILE "<TABLE BORDER=\"1\">\n";

} # html_header




##-----------------------------------------------------------------------------
#
# html_footer	- Build the botom part of the HTML output file
#
# Takes:        Name of current pass, green/yellow/red values for output
# Returns:      Nothing
#
#
##-----------------------------------------------------------------------------

sub html_footer() {
  my $thispass	= shift(@_);
  my $greenval	= shift(@_);
  my $yellowval	= shift(@_);
  my $redval	= shift(@_);

  print OUTFILE "</TABLE>\n";
  print OUTFILE "\n\n";
  print OUTFILE "<p>\n\n";

  print OUTFILE "<a href=\"central_loss.html\">Central Loss</a> | ";
  print OUTFILE "<a href=\"local_loss.html\">Local Loss</a> | ";
  print OUTFILE "<a href=\"fract_lost.html\">Fract Loss</a> | ";
  print OUTFILE "<a href=\"central_rtt.html\">Central RTT</a> | ";
  print OUTFILE "<a href=\"local_rtt.html\">Local RTT</a> | ";
  print OUTFILE "<a href=\"central_jitter.html\">Central Jitter</a> | ";
  print OUTFILE "<a href=\"local_jitter.html\">Local Jitter</a> | ";
  print OUTFILE "<a href=\"beacon_info.html\">Beacon Info</a>";

  if ($writehistory) {
	print OUTFILE " | ";
#	print OUTFILE "<a href=\"history.txt\">$HSECS-second History</a> | ";
	print OUTFILE "<a href=\"history.txt\">History</a> | ";
	print OUTFILE "<a href=\"prevhistory.txt\">Previous History</a>";
  }
  print OUTFILE "<p>\n";

  print OUTFILE "<P>\n\n";
  print OUTFILE "<A HREF=\"http://dast.nlanr.net/projects/beacon/";
  print OUTFILE "beaconfaq.html#mc\">";
  print OUTFILE "Diagnosing problems with your multicast setup</A> |\n";
  print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/#contrib\">";
  print OUTFILE "Contributed code and patches</a><p>\n";
  print OUTFILE " \n";
  print OUTFILE " \n";

  # Show blind Beacons here
  if ($becentralserver && $totalblind) {
	print OUTFILE "<hr noshade>\n";
	print OUTFILE "<a name=\"blind\">\n";
	print OUTFILE "<b>Blind Beacons</b> -- These Beacons are being \n";
	print OUTFILE "correctly \n";
	print OUTFILE "reported to the Central Server, but do not \n";
	print OUTFILE "see any other Beacons, nor are they seen <b>by</b> \n";
	print OUTFILE "any other Beacons.  Check your multicast setup if you \n";
	print OUTFILE "are the admin for any of \n";
	print OUTFILE "the Beacons listed below!\n";
	print OUTFILE "<ul>\n";
	my $ii;
	my $s_ssrc;
	foreach $ii (sort keys %tcp_ssrc_lookup) {
		$s_ssrc = $tcp_ssrc_lookup{$ii};
		if ($blind{$s_ssrc}) {		# Blind Beacon
			print OUTFILE "<li><b>$tcp_host_lookup{$s_ssrc}</b>\n";

			# Notification code 

			#if ($thispass eq "central_loss" &&
			#  defined $tcp_meta{$s_ssrc}[$NOTIFY] && 
			#  $tcp_meta{$s_ssrc}[$NOTIFY] ne -1) {
			#	#print "$tcp_host_lookup{$s_ssrc} - ";
			#	#print "$tcp_meta{$s_ssrc}[$NOTIFY]\n";
			#	#my $MAILPROGRAM = "/bin/mail";
			#	#my $admin_email = "mitch\@ncsa.uiuc.edu";
			#	#my $email		= "mitch\@dast.nlanr.net";
			#	#if ( ! open(MAIL, "| $MAILPROGRAM -s \"Blind Beacon -  
			#	#  $email\" -b $admin_email $email")) {
        	#	#	print "Could not open mail program for notification!\n";
			#	#}
			#	#print MAIL "Blind Beacon!\n";
			#	#close (MAIL);
			#}
		}
	}
	print OUTFILE "</ul>\n";
	print OUTFILE "<hr noshade>\n";
	print OUTFILE "<p>\n";
	print OUTFILE " \n";
  }

  if ($thispass eq "central_loss") {
	print OUTFILE "Central Loss is the reported loss between two Beacons \n";
	print OUTFILE "in the current multicast group, sent via TCP unicast \n";
	print OUTFILE "back to the Central Server (";
	print OUTFILE "in this case, \"$CENTRALSERVERNAME\") for the group. \n";
	print OUTFILE "This allows for the reporting of Beacons that \n";
	print OUTFILE "might not otherwise be able to see each other via UDP \n";
	print OUTFILE "multicast. \n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "local_loss") {
	print OUTFILE "Local Loss is the loss report from this Beacon locally, \n";
	print OUTFILE "without relaying reports back to the Central Server. \n";
	print OUTFILE "This is only what this one particular Beacon \n";
	print OUTFILE "($host_lookup{$thisssrc}, in this case) sees by itself.\n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "fract_lost") {
	print OUTFILE "Fract Lost is the local instantaneous view of RTP \n";
	print OUTFILE "Fract_Lost values, ";
	print OUTFILE "the same as the RQM utility generates, although displayed ";
	print OUTFILE "in the opposite orientation from RQM.\n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "central_rtt") {
	print OUTFILE "<b>Please see the Beacon web page at <br>\n";
	print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/#issues\">";
	print OUTFILE "http://dast.nlanr.net/projects/beacon/#issues</a> for ";
	print OUTFILE " more information -- There is a known ";
	print OUTFILE "bug with RTT right now which we are working on.</b><p>\n";

	print OUTFILE "Central RTT is the reported Round Trip Time between two \n";
	print OUTFILE "Beacons in the current multicast group, sent via TCP \n";
	print OUTFILE "unicast back to the Central Server (";
	print OUTFILE "in this case, \"$CENTRALSERVERNAME\") for the group. \n";
	print OUTFILE "This allows for the reporting of Beacons that \n";
	print OUTFILE "might not otherwise be able to see each other via UDP \n";
	print OUTFILE "multicast. \n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "local_rtt") {
	print OUTFILE "<b>Please see the Beacon web page at <br>\n";
	print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/#issues\">";
	print OUTFILE "http://dast.nlanr.net/projects/beacon/#issues</a> for ";
	print OUTFILE " more information -- There is a known ";
	print OUTFILE "bug with RTT right now which we are working on.</b><p>\n";

	print OUTFILE "Local RTT is the RTT report from this Beacon locally, \n";
	print OUTFILE "without relaying reports back to the Central Server. \n";
	print OUTFILE "This is only what this one particular Beacon \n";
	print OUTFILE "($host_lookup{$thisssrc}, in this case) sees by itself.\n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "local_jitter") {
	print OUTFILE "Jitter is statistical variation in delay, measured in \n";
	print OUTFILE "milliseconds, and represents short-term \n";
	print OUTFILE "network congestion.\n";
	print OUTFILE "<P>\n\n";

  } elsif ($thispass eq "central_jitter") {
	print OUTFILE "Central Jitter is the reported jitter between two \n";
	print OUTFILE "Beacons in the current multicast group, sent via TCP \n";
	print OUTFILE "unicast back to the Central Server (";
	print OUTFILE "in this case, \"$CENTRALSERVERNAME\") for the group. \n";
	print OUTFILE "This allows for the reporting of Beacons that \n";
	print OUTFILE "might not otherwise be able to see each other via UDP \n";
	print OUTFILE "multicast. \n";
	print OUTFILE "<P>\n\n";

  }

  # If the calling routine was "beacon_info", don't plot this part
  # (beacon_info passes in 0/0/0 for color values)
  if ($greenval == 0  && $yellowval == 0 && $redval == 0 ) {
  } else {
	print OUTFILE "<ul>\n";
	print OUTFILE " <li>";
	
	my $label = ucfirst($thispass);
	print OUTFILE "$label of 0 - $greenval = Green, ";
	print OUTFILE "$greenval - $yellowval = Yellow, ";
	print OUTFILE "$yellowval - $redval = Red, ";
	print OUTFILE "No data (\"NA\") = Gray\n";
	
	print OUTFILE " <li>R# and S# are the same Beacon.";
	print OUTFILE " Any given cell in this table is read as \"How well does ";
	print OUTFILE "Beacon R# see Beacon S#?\".\n<br>\n";
	
	print OUTFILE " <li>The dark green background in the R column shows  which ";
	print OUTFILE "Beacon is generating the table you are seeing here.<br>\n";
	print OUTFILE "</ul>";
  }

  if ($showreports) {
	print OUTFILE "The \"RRs\" column is the count of RTP Receiver ";
	print OUTFILE "Reports received from each SR during the previous ";
	print OUTFILE "interval.  For any given interval, the count of reports ";
	print OUTFILE "should be approximately the same.  If your Beacon's ";
	print OUTFILE "report count is much lower than the others, it means ";
	print OUTFILE "your Beacon has only recently joined the multicast ";
	print OUTFILE "If you know you Beacon has been running for some time, ";
	print OUTFILE "it may be showing router-level multicast problems, which ";
	print OUTFILE " is why the option was included in this release of the ";
	print OUTFILE "Beacon.  If your Beacon is joining and leaving and joining ";
	print OUTFILE "and leaving, this it what that would look  like.<p>\n";
  }

  print OUTFILE "<P>\n\n";

  print OUTFILE "Please share your comments, questions, bug reports, \n";
  print OUTFILE "concerns, and feedback with us via the Beacon listserv.\n";
  print OUTFILE "<b>Please note this list can only be posted to by \n";
  print OUTFILE "SUBSCRIBERS, in order to keep it spam-free.</b>\n";
  print OUTFILE "Non-subscriber email is automatically discarded.  \n";
  print OUTFILE "You can subscribe to the list by sending an email to \n";
  print OUTFILE "\"majordomo /at/ dast.nlanr.net\", with \n";
  print OUTFILE "\"subscribe beacon /at/ dast.nlanr.net\" (with real \"at\" \n";
  print OUTFILE "signs, of course) in the body.  \n";
  print OUTFILE "This list is publicly archived at \n";
  print OUTFILE "<a href=\"http://archive.ncsa.uiuc.edu/lists/beacon\">";
  print OUTFILE "http://archive.ncsa.uiuc.edu/lists/beacon</a>.\n";
  print OUTFILE "<p>\n";

  print OUTFILE "<p>\n";

  print OUTFILE "Another way to contact us is to use the \n";
  print OUTFILE "<a href=\"http://dast.nlanr.net/contactform.html\">DAST \n";
  print OUTFILE "contact webform</a>.\n";

  print OUTFILE "</BODY>\n</HTML>\n";
        

} # html_footer




##-----------------------------------------------------------------------------
#
# history_output - Outputs current stats info to comma-delimited history file
# 
#
# Takes:        Nothing
# Returns:      Nothing
#
#
##-----------------------------------------------------------------------------

sub history_output {
  my $historyoutfile;	# for file we'll be writing to
  my $now = time;		# Get the current time

  if (! defined $lasthistory) {		# Start the timer
    $lasthistory = $now;
    # Open the file for overwriting
    $historyoutfile = ">" . $outputdir . "/" . $HISTORYFILE;

  # 600 = 10 mins - Push  file to past file, start current fresh
  } elsif (($now - $lasthistory) > $HSECS ) {
    if (-e $outputdir . "/" . $HISTORYFILE) {	# There's a file there to rename
        rename $outputdir . "/" . $HISTORYFILE, $outputdir . "/" . $PREVHISTORYFILE  || 
			die ("Couldn't rename HISTORYFILE " );
    }
    $lasthistory = $now;					# Reset the timer
    # Open the file for overwriting
    $historyoutfile = ">" . $outputdir . "/" . $HISTORYFILE;

  } else {									# Normal writing pass -- append data
    # Open the file for overwriting
    $historyoutfile = ">>" . $outputdir . "/" . $HISTORYFILE;
  }

  open(HISTORYFILE, $historyoutfile) || die ("HISTORYFILE open failed" );

  if ($lasthistory == $now) {       # First line of new file
    print HISTORYFILE "Updated every $WEBREFRESH seconds, ";
    print HISTORYFILE "cycles history.txt to prevhistory.txt every ";
    print HISTORYFILE "$HSECS seconds.\n";
    print HISTORYFILE "Format is: Year, Month, Day, Hour, Minute, Second, ";
    print HISTORYFILE "S_SSRC, R_SSRC, S_SSRC IP, R_SSRC IP, Loss, RTT, ";
	print HISTORYFILE "Jitter\n";
  }

  my $datetemp = &ctime(time);		# Get the current time
  chomp $datetemp;					# Remove trailing line return
  my @d = split /\s+/, $datetemp;	# Get useable fields

  # THIRD THROUGH Nth LINES....  Data
	foreach my $s_ssrc (sort keys %tcp_host_lookup) {

    # Send the actual data - What THIS Beacon sees
	foreach my $r_ssrc (sort keys %tcp_host_lookup) {

		# Only show values that are legit
		if (defined $tcp_stats{$s_ssrc}{$r_ssrc}) {
			# 2003,10,23,14:32:46
			print HISTORYFILE "$d[4],$mth{$d[1]},$d[2],$d[3],";

			# Who do they see?
			printf HISTORYFILE "0x%08x,", $s_ssrc;
			printf HISTORYFILE "0x%08x,", $r_ssrc;
			print HISTORYFILE "$tcp_ip_lookup{$s_ssrc},";
			print HISTORYFILE "$tcp_ip_lookup{$r_ssrc},";
			if (defined $tcp_stats{$s_ssrc}{$r_ssrc}[$INTERVAL_LOSS]) {
				print HISTORYFILE "$tcp_stats{$s_ssrc}{$r_ssrc}[$INTERVAL_LOSS],";
			} else { 
				print HISTORYFILE "-1,";
			}
			if (defined $tcp_stats{$s_ssrc}{$r_ssrc}[$RTT]) {
				print HISTORYFILE "$tcp_stats{$s_ssrc}{$r_ssrc}[$RTT],";
			} else { 
				print HISTORYFILE "-1,";
			}
			if (defined $tcp_stats{$s_ssrc}{$r_ssrc}[$JITTER]) {
				print HISTORYFILE "$tcp_stats{$s_ssrc}{$r_ssrc}[$JITTER]\n";
			} else { 
				print HISTORYFILE "-1\n";
			}
		}
	}
  }
  # and terminate the connection when we're done
  close(HISTORYFILE) || die ("Couldn't close HISTORYFILE" );

  return;
} # history_output




##-----------------------------------------------------------------------------
#
# get_loss      - Get loss-over-interval values for this Beacon pair
#                 once we have more than one interval's worth of data
#
# Takes:        S_SSRC and R_SSRC
# Returns:      Initial loss value for the pair
#
#
##-----------------------------------------------------------------------------

sub get_loss() {
    my $stats  = shift(@_);
    my $s_ssrc = shift(@_);
    my $r_ssrc = shift(@_);
    my $thispass = shift(@_);
    my $value = -1;
    my $lost;
    my $expected;

    if (defined $$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ] && 
		defined $$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST]) {

		if (defined $$stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ] && 
			defined $$stats{$s_ssrc}{$r_ssrc}[$PREV_LOST]) { 

			# DEBUG
			if ($DEBUG > 2) {
				printf "0x%08x | 0x%08x: %s ", $s_ssrc, $r_ssrc, $thispass;
				print " fract = $$stats{$s_ssrc}{$r_ssrc}[$FRACT_LOST]";
				print "\n";
			}
			# END DEBUG

		    $expected = $$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ] - 
				$$stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ];
		    $lost = $$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST] - 
				$$stats{$s_ssrc}{$r_ssrc}[$PREV_LOST];

		    if ($expected) {
		       	$value = int(($lost / $expected ) * 100);
				if ($value < 0 ) {
					$value = 0;
				}
		    }
		    else {
				$value = 0;
		    }

   	    } else {
		    $value = -1;
		}

       	$$stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ] = 
			$$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ];
       	$$stats{$s_ssrc}{$r_ssrc}[$PREV_LOST] = 
			$$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST];
    }

    return $value;
}


##-----------------------------------------------------------------------------
# 
# reverse_name		- Reverses any given DNS (dotted-quad) name
#
# Takes:	Name to reverse		Eg., "yendi.ncsa.uiuc.edu"
# Returns:	Reversed name		Eg., "edu.uiuc.ncsa.yendi"
#
##-----------------------------------------------------------------------------

sub reverse_name() {
  my $startwith = shift(@_);

  my $kk;
  my $reverse_tld;

  # Split current name into component pieces
  my @tld = split /\./, $startwith;

  foreach $kk (reverse @tld) {	# reverse the pieces for sorting
    $reverse_tld .= $kk . ".";	# concat $reverse_tld with next chunk and a "."
  }

  chop $reverse_tld;			# Whack trailing "."

  return ($reverse_tld);		# Send back the reversed name

} # reverse_name

##-----------------------------------------------------------------------------
#
# get_sortname		- Generate the sortname to use for the hash tables
#
# Takes:	hostname and ssrc of the Beacon to generate the name for
# Returns:	sortname
#
# Takes hostname, reverses it, concatenates SSRC onto it with "|" in between
#
##-----------------------------------------------------------------------------

sub get_sortname() {
  my $startname = shift(@_);
  my $ssrc		= shift(@_);

  my $sortname	= &reverse_name($startname) . "|" . $ssrc;

  return $sortname;

} # get_sortname


##-----------------------------------------------------------------------------
#
# add_beacon		- Add the appropriate data to the appropriate tables to
#                 create a new Beacon entry. Used when a Beacon joins group.
#
# Takes:	sortname, hostname, ip address, ssrc
# Returns:	nothing
#
#
##-----------------------------------------------------------------------------

sub add_beacon() {
  my $sortname = shift(@_);
  my $hostname = shift(@_);
  my $hostip = shift(@_);
  my $ssrc = shift(@_);

  # Host name and Existence marker - "yendi.ncsa.uiuc.edu"
  # build table of ssrcs / hostnames
  $host_lookup{$ssrc}		= $hostname;

  # build table of ssrcs/IPs
  $ip_lookup{$ssrc}   = $hostip;
    
  # build table of sortable names/ssrcs
  $ssrc_lookup{$sortname}	= $ssrc;

  # build table of ssrcs/ sortable names
  $sort_lookup{$ssrc}		= $sortname;

} # add_beacon


##-----------------------------------------------------------------------------
#
# del_beacon		- Delete the requested Beacon
#
# Takes:	ssrc to delete
# Returns:	nothing
#
#
##-----------------------------------------------------------------------------

sub del_beacon() {
  my $ssrc	= shift(@_);
  my $ip	= $ip_lookup{$ssrc};
  my $host	= $host_lookup{$ssrc};
  my $sort	= $sort_lookup{$ssrc};

  if (defined $ip && defined $sort && defined $host && defined $ssrc) { 
	my $datetemp = &ctime(time);	# Get the current time
	chomp $datetemp;				# Whack trailing line return
  	#printf "0x%08x, %s, %s\n", $ssrc, $ip, $sort;
	delete $sort_lookup{$ssrc} || die ("NAME_TABLE delete failed" );



	if (! delete $ip_lookup{$ssrc}) {
		printf "IP_LOOKUP delete failed 0x%08x, %s, %s\n", $ssrc, $ip, $host;
	}

	if (! delete $host_lookup{$ssrc}) {
		printf "HOST_LOOKUP delete failed 0x%08x, %s, %s\n", $ssrc, $ip, $host;
	}

	my $var;
	foreach $var (keys %ssrc_lookup) {
		if ($ssrc_lookup{$var} == $ssrc) {
			delete $ssrc_lookup{$var} || die ("SSRC_LOOKUP delete failed" );
		}
	}

	# Whack any saved stats for this Beacon
	foreach $var (keys %stats) {
		if ($var  == $ssrc) {
			if (defined $stats{$ssrc}) {
				delete $stats{$ssrc} || die ("STATS delete failed" );
			}
		}
	}

  }

  # Whack the report counter hash
  if (defined $reports{$ssrc}) {
	delete $reports{$ssrc};
  }

} # del_beacon


##-----------------------------------------------------------------------------
#
# host_lookup_output
#
##-----------------------------------------------------------------------------

sub host_lookup_output {
  my $host_lookup	= shift(@_);
  my $thispass	= shift(@_);

  my $datetemp = &ctime(time);				# Get the current time
  # open the temporary outfile - Where we'll be writing debug data 
  # off to prior to swapping it into the real file.
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";

  # leaving off the "\n" newline char in the text of the -die- causes 
  # it to print error info
  open(OUTFILE, $outfile2) || die ("HOST_LOOKUP OUTFILE open failed" );
  print OUTFILE "$datetemp";

  my $ii;
  my $count=0;
  foreach $ii (sort keys %$host_lookup) {
    printf OUTFILE "%d %s, 0x%08x\n", $count, $$host_lookup{$ii}, $ii;
    $count++;
  }

  close(OUTFILE) || die ("Couldn't close host_LOOKUP OUTFILE \"$outfile\"" );

  # Swap the temp file into the real file.  "*Whump*!"
  rename "$outfile", $outputdir . "/" . $thispass . "\.txt" || 
	die ("Couldn't rename NAME_LOOKUP OUTFILE \"$outputdir/$outfile\" to 
		\"$thispass . \".html\"\"" );
}

# host_lookup_output


##-----------------------------------------------------------------------------
#
# ssrc_lookup_output
#
##-----------------------------------------------------------------------------

sub ssrc_lookup_output {
  my $ssrc_lookup	= shift(@_);
  my $thispass		= shift(@_);

  my $datetemp = &ctime(time);				# Get the current time
  # open the temporary outfile - Where we'll be writing 
  # debug data off to prior to swapping it into the real file....
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";

  # leaving off the "\n" newline char in the text of the -die- causes 
  # it to print error info
  open(OUTFILE, $outfile2) || die ("SSRC_LOOKUP OUTFILE open failed" );
  print OUTFILE "$datetemp";

  my $ii;
  my $count=0;
  foreach $ii (sort keys %$ssrc_lookup) {
    printf OUTFILE "%d 0x%08x, %s\n", $count, $$ssrc_lookup{$ii}, $ii;
    $count++;
  }

  close(OUTFILE) || die ("Couldn't close SSRC_LOOKUP OUTFILE \"$outfile\"" );

  # Swap the temp file into the real file.  "*Whump*!"
  rename "$outfile", $outputdir . "/" . $thispass . "\.txt" || 
		die ("Couldn't rename SSRC_LOOKUP OUTFILE \"$outputdir/$outfile\" to 
		\"$thispass . \".html\"\"" );
}

# ssrc_lookup_output


##-----------------------------------------------------------------------------
#
# ip_lookup_output
#
##-----------------------------------------------------------------------------

sub ip_lookup_output {
  my $ip_lookup	= shift(@_);
  my $thispass	= shift(@_);

  my $datetemp = &ctime(time);				# Get the current time
  # open the temporary outfile - Where we'll be writing 
  # debug data off to prior to swapping it into the real file....
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";

  # leaving off the "\n" newline char in the text of the -die- causes 
  # it to print error info
  open(OUTFILE, $outfile2) || die ("IP_LOOKUP OUTFILE open failed" );
  print OUTFILE "$datetemp";

  my $ii;
  my $count=0;
  foreach $ii (sort keys %$ip_lookup) {
    printf OUTFILE "%d %s, 0x%08x\n", $count, $$ip_lookup{$ii}, $ii;
    $count++;
  }

  close(OUTFILE) || die ("Couldn't close IP_LOOKUP OUTFILE \"$outfile\"" );

  # Swap the temp file into the real file.  "*Whump*!"
  rename "$outfile", $outputdir . "/" . $thispass . "\.txt" || 
		die ("Couldn't rename IP_LOOKUP OUTFILE \"$outputdir/$outfile\" to 
		\"$thispass . \".html\"\"" );
}

# ip_lookup_output




##-----------------------------------------------------------------------------
#
# sort_lookup_output
#
##-----------------------------------------------------------------------------

sub sort_lookup_output {
  my $sort_lookup	= shift(@_);
  my $thispass	= shift(@_);

  my $datetemp = &ctime(time);				# Get the current time
  # open the temporary outfile - Where we'll be writing debug data 
  # off to prior to swapping it into the real file.
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";

  # leaving off the "\n" newline char in the text of the -die- causes 
  # it to print error info
  open(OUTFILE, $outfile2) || die ("NAME_LOOKUP OUTFILE open failed" );
  print OUTFILE "$datetemp";

  my $ii;
  my $count=0;
  foreach $ii (sort keys %$sort_lookup) {
    printf OUTFILE "%d %s, 0x%08x\n", $count, $$sort_lookup{$ii}, $ii;
    $count++;
  }

  close(OUTFILE) || die ("Couldn't close NAME_LOOKUP OUTFILE \"$outfile\"" );

  # Swap the temp file into the real file.  "*Whump*!"
  rename "$outfile", $outputdir . "/" . $thispass . "\.txt" || 
	die ("Couldn't rename NAME_LOOKUP OUTFILE \"$outputdir/$outfile\" to 
		\"$thispass . \".html\"\"" );
}

# sort_lookup_output


##-----------------------------------------------------------------------------
#
# stats_table_output
#
##-----------------------------------------------------------------------------

sub stats_table_output {
  my $stats			= shift(@_);
  my $host_lookup	= shift(@_);
  my $thispass		= shift(@_);

  my @indeces = ("FL", "TL", "J", "LS", "TS", "RTT", "IL", "IS", "ITS", 
				"PL", "PS", "PRT", "PTS", "PLV", "RT", "RC");

  my $datetemp = &ctime(time);				# Get the current time
  
  # open the temporary outfile - Where we'll be writing debug 
  # data off to prior to swapping it into the real file....
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";
  
  # leaving off the "\n" newline char in the text of the -die- causes 
  # it to print error info
  open(OUTFILE, $outfile2) || die ("STATS_TABLE OUTFILE open failed" );
  print OUTFILE "$thispass on $datetemp";

  my $outercount=0;

  # Run through all the stats we have saved so far
  foreach my $s_ssrc (sort keys %$stats) {
	$datetemp = &ctime(time);	# Get the current time
	chomp $datetemp;				# Remove trailing line return

    printf OUTFILE "$thispass - Outer %d ", $outercount;
    printf OUTFILE "0x%08x ", $s_ssrc;
    printf OUTFILE "at %s\n", $datetemp;
    my $count=0;
    foreach my $r_ssrc (sort keys %$stats) {
        if ( defined $$stats{$s_ssrc}{$r_ssrc} && 
			defined $$host_lookup{$s_ssrc} && defined $$host_lookup{$r_ssrc}) {
            printf OUTFILE "  Inner %d  %s, 0x%08x, %s,  0x%08x\n", 
				$count, $$host_lookup{$s_ssrc}, $s_ssrc, 
				$$host_lookup{$r_ssrc}, $r_ssrc;

			my $ic;	# inner counter
			for ($ic=0; $ic<16; $ic++) {
				print OUTFILE "\t$indeces[$ic]: ";
				if (defined $$stats{$s_ssrc}{$r_ssrc}[$ic]) {
					print OUTFILE "$$stats{$s_ssrc}{$r_ssrc}[$ic]";
				} else {
					print OUTFILE "-1";
				}
				print OUTFILE "\n";
			}
	
        }
        $count++;
    }
    print OUTFILE "\n";
    $outercount++;
  }
  print OUTFILE "\n";
  close(OUTFILE) || die ("Couldn't close STATS_TABLE OUTFILE \"$outfile\"" );
         
}   # stats_table_output


##-----------------------------------------------------------------------------
#
# contactinfo_output
#
##-----------------------------------------------------------------------------

sub contactinfo_output() {

  # Open the file
  my $contactfile = ">" . $outputdir . "/" . "contact_info\.txt";
  my $myctime = &ctime(time);
  chomp $myctime;
  open(CONTACTFILE, $contactfile) || die ("CONTACTFILE open failed" );

  # Print the Contact Name and Info
  my $ssrc;
  my $i=0;

  print CONTACTFILE "Contact info updated on $myctime\n";

  foreach $ssrc (sort keys %tcp_meta) {

	if ( defined $tcp_meta{$ssrc}[$NAME] && defined $tcp_meta{$ssrc}[$INFO] ) {
		my $started;
		my $last_heard;
#		if ($tcp_meta{$ssrc}[$NOTIFY] == -1 ) {
		if ($tcp_meta{$ssrc}[$NOTIFY] eq "-1" ) {
			print CONTACTFILE "No NOTIFY Address, ";
		} else {
			print CONTACTFILE "Notifies go to: $tcp_meta{$ssrc}[$NOTIFY], ";
		}
		print CONTACTFILE "$i) $tcp_meta{$ssrc}[$NAME], ";
		print CONTACTFILE "$tcp_meta{$ssrc}[$INFO], ";
		print CONTACTFILE "$tcp_meta{$ssrc}[$LOC], ";
		print CONTACTFILE "Running $tcp_meta{$ssrc}[$OS], ";
		print CONTACTFILE "Perl Version $tcp_meta{$ssrc}[$PERLVER], ";
		print CONTACTFILE "User $tcp_meta{$ssrc}[$USER], ";
		$started = &ctime($tcp_meta{$ssrc}[$START]);
		chomp $started;
		print CONTACTFILE "Started $started, ";
		$last_heard = &ctime($tcp_meta{$ssrc}[$LAST_HEARD]);
		chomp $last_heard;
		print CONTACTFILE "Last heard from  $last_heard\n";
   	}

    $i++;
  }
  close(CONTACTFILE) || die ("Couldn't close CONTACTFILE \"$contactfile\"" );

}	# contactinfo_output



##-----------------------------------------------------------------------------
# 
# drain_queue		- Drains the event queue as we leave the matrix
#
# Takes:	Nothing.
#
# Returns:	Nothing
#
##-----------------------------------------------------------------------------

sub drain_queue() {
  while($event = beacon_get_next_event()) {
	if($event->{type} == $RX_RR) {
		my $rr = $event->{rr};
		print "GOT RR FROM SSRC: " . $rr->{ssrc} . "\n"
	}

	beacon_free_event($event);

  }
 
  # Sanity Debug check here -- We just drained all beacons from 
  # the queue, so $ql *should* be zero.
  my $ql = beacon_queue_len();
  if($ql != 0) {
      print "QUEUE WHACKED: $ql\n";
  }
} #  drain_queue


##-----------------------------------------------------------------------------
# 
# create_new_pid	- Creates new PID file for currently running process
#
# Takes:	Nothing.
#
# Returns:	Nothing
#
##-----------------------------------------------------------------------------

sub create_new_pid {
  my $beaconpidfile2 = ">" . $outputdir . "/" . $beaconpidfile;

  open(BEACONPIDFILE, $beaconpidfile2) || die ("BEACONPIDFILE open failed" );
  # "$$" is perl for "process ID", so I know what to kill next time.
  print BEACONPIDFILE "$$";
  close(BEACONPIDFILE) || die ("Couldn't close BEACONPIDFILE in create_new_pid" );

} # create_new_pid


##-----------------------------------------------------------------------------
# 
# kill_existing_pid	- Kills any existing PID file created during current run
#
# Takes:	Nothing.
#
# Returns:	Nothing
#
##-----------------------------------------------------------------------------

sub kill_existing_pid {

  my $beaconpidfile2 = $outputdir . "/" . $beaconpidfile;

  # If a Beacon is already running, kill it before starting a new one
  if (-e $beaconpidfile2) {
    open(BEACONPIDFILE, $beaconpidfile2) || 
		die ("BEACONPIDFILE open/read failed" );
    my $pidtokill = <BEACONPIDFILE>;
    my $running = (kill 0 => $pidtokill);   # Is this process still running?

    # Is it running?  (PID of 0 says "Kill all the processes that 
	# belong to me!" - That would be BAD.)
    if ($running && $pidtokill != 0) {

#        kill 9 => $pidtokill || 
#			die ("Failed to kill running Beacon process $pidtokill" );
        kill("TERM", $pidtokill);
        print "Wait......\n";
        sleep 2;	# Give time for cleanup to occur, so immediate restart is ok
        print "Stopped a previously running Beacon (PID = $pidtokill) prior ";
		print "to starting this Beacon.\n";
    }
    close(BEACONPIDFILE) || die ("Couldn't close BEACONPIDFILE" );
  }
} # kill_existing_pid


##-----------------------------------------------------------------------------
# 
# sigpipe_cather	- Catch SIGPIPE failures from TCP send/recv functions
# 
##-----------------------------------------------------------------------------
sub sigpipe_catcher {	# Empty placeholder just to catch errant SIGPIPEs
  print "Caught sigpipe\n";
} # sigpipe_catcher




##-----------------------------------------------------------------------------
# 
# pre_exit_cleanup	- Clean up before exiting
#
# Takes:	Nothing.
#
# Returns:	Nothing
#
# Sends a BYE and then a DONE to the group, so the other Beacons know we're
# leaving.  
# Deletes (well, -unlinks-) the PID file, so we can know that no Beacon is 
# currently running here when we look later.  
# Writes a showdown message to the main HTML file  by default, so you don't
# keep looking at the same  HTML page forever, thinking it's getting updated.
# Sends a delete signal to the Central Server to remove this Beacon from the
# list.
#
##-----------------------------------------------------------------------------

sub pre_exit_cleanup {
#  my $fh;
#  my @all;

  # If sending data back to Central Server, tell it to drop this Beacon
  if (defined $CENTRALSERVERNAME && (! $becentralserver)) {
	# DEBUG
	if ($DEBUG > 1) {
		print "Sending TCP_DELETE signal at exit.\n";
	}
	# END DEBUG

    &send_central_delete;
  }

  my $beaconpidfile2 = $outputdir . "/" . $beaconpidfile;

  my $datetemp = &ctime(time);	# Get the current time
  chop $datetemp;				# Remove trailing line return

  # Leave nicely.  ("Don't go away angry....."
  rtp_send_bye($thissession);		# Say we're leaving
  rtp_done($thissession);			# Leave

  print "\n\n\n";               # Generate some blank lines.

  if (-e $beaconpidfile2) {
    unlink $beaconpidfile2 || die ("Cleanup of BEACONPIDFILE failed" );
    print "Temporary PID file successfully removed.\n";
  }

  # Close the listening "I'm a central server" connection
#  if ($becentralserver) {
#     @all = $select->handles;
#     foreach $fh (@all) {
#      if ($fh != $server) {
#       $select->remove($fh); 
#       close($fh);
#      }
#     }
	# If we still have an open server connection, close it.
#	if (defined $server) {
#		close($server) || 
#			die ("Couldn't close Central Server TCP connection " );
#		print "Central Server connection successfully closed.\n";
#	}
#  }

  # Default behavior is to generate shutdown messages
  if (! $noshutdownmsg) {
	output_beacon_shutdown_message("fract_lost");
	output_beacon_shutdown_message("local_loss");
	output_beacon_shutdown_message("local_rtt");
	output_beacon_shutdown_message("local_jitter");
	# one of these for beacon_info, too?  - Mitch

    if ($becentralserver) {
		output_beacon_shutdown_message("central_loss");
		output_beacon_shutdown_message("central_rtt");
		output_beacon_shutdown_message("central_jitter");
		kill("INT", $childpid);
	}
  } else {
	print "No shutdown message written to HTML files.\n";
  }


  # Say when this happened.
  print "Beacon shutdown successful on $datetemp\n";

  exit;

}   # pre_exit_cleanup

sub child_cleanup {
  my @all;
  my $fh;

  @all = $select->handles;
  foreach $fh (@all) {
    if ($fh != $server) {
      $select->remove($fh);
      close($fh);
    }
  }
  close ($server);
  print "child exiting\n";
  exit;
}

sub child_notify {
	# Check for timedout Beacons and remove
	&remove_timedout_beacons();

    &central_update;
    $SIG{ALRM}  = \&child_notify;
#    print "notifying child\n";
}

sub central_update {
    &html_update_central();
    &beacon_info_output();
    if ($writehistory) {
	&history_output(); # Generate flast-text CSV of stats
    }
    if ( $DEBUG > 0 ) {
	&contactinfo_output();
    }
#    print "child updating central pages\n";
}

##-----------------------------------------------------------------------------
#
# send_central_delete	- Sends TCP message to Central Server to delete a beacon
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------


sub send_central_delete {

  # DEBUG
  if ($DEBUG > 1) {
	print "Sending TCP delete signal.\n";
  }
  # END DEBUG

# Open TCP socket back to the Central Beacon Server

  if ((! defined $client) || (! defined $client->connected)) {

      $client = IO::Socket::INET->new(PeerAddr => $CENTRALSERVERNAME,
	      PeerPort => $SERVERTCPPORT,
	      Proto => "tcp", TYPE => SOCK_STREAM);
      if (defined $client) {
	  my $flags = fcntl($client, F_GETFL, 0)
	      || die "Can't get flags for the Central Server socket: $!\n";
	  $flags = fcntl($client, F_SETFL, $flags | O_NONBLOCK)
	      || die "Can't set flags for the Central Server socket: $!\n";

	  if ($connection_to_tcp_server == 0) {
	      print "Connection to Central Server established!\n";
	  }
	  $connection_to_tcp_server = 1;
      } else {
	  if ($connection_to_tcp_server == 1) {
	      printf "Waiting to connect to Central Server...\n";
	  } 
	  $connection_to_tcp_server = 0;
	  return; 
      }
  }

  # AUTHENTICATION string --  Central Server will ignore any TCP
  # traffic that doesn't start with this line.
  # "beacon.dast.nlanr.net:233.4.200.18:10004"  
  &beacon_print($client, "$CENTRALSERVERNAME|$GROUP|$PORT|$VER\n");

  # SECOND LINE -- Sending Beacon identifying info.
  # Uniquely identify who the report is coming from.

  &beacon_print($client, "$thisssrc|$thishost|$thisuser|$thisip|$^O|");
  if (defined $CONTACTNAME) {
	&beacon_print($client, "$CONTACTNAME|");
  } else {
	&beacon_print($client, "Undefined|");
	printf "0x%08x, CONTACTNAME undefined.\n", $thisssrc;
  }
  if (defined $CONTACTINFO) {
	&beacon_print($client, "$CONTACTINFO|");
  } else {
	&beacon_print($client, "Undefined|");
	printf "0x%08x, CONTACTINFO undefined.\n", $thisssrc;
  }
  if (defined $CONTACTLOCATION) {
	&beacon_print($client, "$CONTACTLOCATION|");
  } else {
	&beacon_print($client, "Undefined|");
	printf "0x%08x, CONTACTLOCATION undefined.\n", $thisssrc;
  }
  if (defined $timestarted) {
	&beacon_print($client, "$timestarted|");
  } else {
	&beacon_print($client, "Undefined|");
	printf "0x%08x, timestarted undefined.\n", $thisssrc;
  }
  if (defined $reports{$thisssrc}) {
	&beacon_print($client, "$reports{$thisssrc}\n");
  } else {
	&beacon_print($client, "Undefined\n");
	printf "0x%08x, reports{thisssrc} undefined.\n", $thisssrc;
  }


  # THIRD THROUGH Nth LINES....  Data
  &beacon_print($client, "$DELETETCPENTRY\|$thisssrc\n");

  &beacon_print($client, $ENDMESSAGE);

  # DEBUG
  if ($DEBUG > 1) {
	print "Sent Delete signal to Central Server.\n";
  }
  # END DEBUG


  # and terminate the connection when we're done
  close($client) || die ("Couldn't close TCP reporting socket" );

  # DEBUG
  if ($DEBUG > 1) {
	print "Closed connection to Central Server.\n";
  }
  # END DEBUG

  return;

} # send_central_delete




##-----------------------------------------------------------------------------
#
# output_beacon_shutdown_message	- Print shutdown message to main HTML file
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub output_beacon_shutdown_message {
  # Get type of output we're generating -- "rqm" in this case
  my $thispass= shift(@_);

  # open the temporary outfile - Where we'll be writing HTML 
  # data off to prior to swapping it into the real file....
  # For -rename- at end of file.
  my $outfile = $outputdir . "/" . $thispass . "\.TEMP";

  # For the -OPEN- right here.
  my $outfile2 = ">" . $outputdir . "/" . $thispass . "\.TEMP";

  open(OUTFILE, $outfile2) || die ("Beacon OUTFILE open failed" );

  my $datetemp = &ctime(time);	# Get the current time
  chop $datetemp;				# Remove trailing line return

  # Start the HTML file
  print OUTFILE "<HTML>\n<HEAD>\n";
  print OUTFILE "  <TITLE>NLANR/DAST Beacon not running - $datetemp</TITLE>\n";
  print OUTFILE "  <META HTTP-EQUIV=\"REFRESH\" CONTENT=\"$WEBREFRESH\">\n";
  print OUTFILE "</HEAD>\n\n<BODY>\n";
  print OUTFILE "<TABLE WIDTH=\"100%\">\n <TR>\n  ";
  print OUTFILE "<TD NOWRAP ALIGN=\"BOTTOM\">\n";
  print OUTFILE "   <FONT SIZE=\"5\"><B>";
  print OUTFILE "<a href=\"http://dast.nlanr.net/projects/beacon/\">";
  print OUTFILE "Multicast Beacon</a></B>";
  print OUTFILE "</FONT>\n";
  print OUTFILE "   <FONT SIZE=\"2\">v$VER-$SUBVER</FONT><BR>\n";
  print OUTFILE "  </TD>\n  <TD>\n";
  print OUTFILE "  </TD>\n";
  print OUTFILE " </TR>\n</TABLE>\n";

  # Write the links to the other files
  print OUTFILE "<P>\n\n";

  if ($showmotd) {				# Show the MOTD if flagged
    print OUTFILE "<p>\n\n<b>$MOTD</b><p>";
  }

  # Write the general information about this particular BeaconServer session
  print OUTFILE "Shutdown Time: <B>$datetemp</B>\n";
  print OUTFILE "<P>\n\n";

  print OUTFILE "<P>\n\n";

  # If central server, show CNAME alias (beacon.dast.nlanr.net) instead of
  # machine's actual hostname (jhereg.ncsa.uiuc.edu)
  my $tempbeacon;
  if ($becentralserver) {
	$tempbeacon = $CENTRALSERVERNAME;
  } else {
	$tempbeacon = $thishost;
  }

  print OUTFILE "<font size=\"4\"><b>This Beacon, \"$tempbeacon\", is ";
  print OUTFILE "not currently running.<br>\n";
  print OUTFILE "It was shut down or killed $datetemp.<\/b><\/font>\n";
  print OUTFILE "<P>\n\n";

  print OUTFILE "<P>\n\n";
  print OUTFILE "<A HREF=\"http://dast.nlanr.net/projects/beacon/";
  print OUTFILE "beaconfaq.html#mc\">";
  print OUTFILE "Diagnosing problems with your multicast setup</A>\n<P>\n\n";

  print OUTFILE "<P>\n\n";
  print OUTFILE "<P>\n\n";

  print OUTFILE "Please share your comments, questions, bug reports, \n";
  print OUTFILE "concerns, and feedback with us via the Beacon listserv.\n";
  print OUTFILE "<b>Please note this list can only be posted to by \n";
  print OUTFILE "SUBSCRIBERS, in order to keep it spam-free.</b>\n";
  print OUTFILE "Non-subscriber email is automatically discarded.  \n";
  print OUTFILE "You can subscribe to the list by sending an email to \n";
  print OUTFILE "\"majordomo /at/ dast.nlanr.net\", with \n";
  print OUTFILE "\"subscribe beacon /at/ dast.nlanr.net\" (with real \"at\" \n";
  print OUTFILE "signs, of course) in the body.  \n";
  print OUTFILE "This list is publicly archived at \n";
  print OUTFILE "<a href=\"http://archive.ncsa.uiuc.edu/lists/beacon\">";
  print OUTFILE "http://archive.ncsa.uiuc.edu/lists/beacon</a>.\n";
  print OUTFILE "<p>\n";

  print OUTFILE "<p>\n";

  print OUTFILE "Another way to contact us is to use the \n";
  print OUTFILE "<a href=\"http://dast.nlanr.net/contactform.html\">DAST \n";
  print OUTFILE "contact webform</a>.\n";
  print OUTFILE "</BODY>\n</HTML>\n";
  close(OUTFILE) || 
	die ("Couldn't close \"No Beacon\" HTML OUTFILE \"$outfile\"" );

  # Swap the temp file into the real file.  "*Whump*!"  
  rename "$outfile", $outputdir . "/" . $thispass . ".html" || 
	die ("Couldn't rename \"$outputdir/$thispass.TEMP\" OUTFILE \"$outfile\" 
		to \"$thispass.html\"" );
  print "Message showing shutdown copied into \"$outputdir/$thispass.html\".\n";

} # output_beacon_shutdown_message

sub beacon_print {
  my $sock = shift(@_);
  my $message = shift(@_);

  if (!defined($sock)) {
    print "client not defined\n";
    return;
  }
  if (!defined(send($sock, $message, 0))) {
    print "send from client failed\n";
    close($sock);
    undef $sock;
    return;
  }
}

##-----------------------------------------------------------------------------
#
# send_central_report - Sends Beacon reports back to Central Server via TCP.
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub send_central_report {
# If client connection does not yet exist, try to open

    if (!defined($client)) {
	print "Opening client connection\n";
	$client = IO::Socket::INET->new(PeerAddr => $CENTRALSERVERNAME,
		PeerPort => $SERVERTCPPORT,
		Proto => "tcp", TYPE => SOCK_STREAM);

	if (defined($client)) {
#	    printf "Client is defined\n";
	    my $flags = fcntl($client, F_GETFL, 0)
		|| die "Can't get flags for the Central Server socket: $!\n";
	    $flags = fcntl($client, F_SETFL, $flags | O_NONBLOCK)
		|| die "Can't set flags for the Central Server socket: $!\n";

	    if ($connection_to_tcp_server == 0) {
		print "Connection to Central Server established!\n";
	    }
	    $connection_to_tcp_server = 1;
	} else {
	    printf "Client is not defined\n";
	    if ($connection_to_tcp_server == 1) {
		printf "Waiting to connect to Central Server...\n";
	    } 
	    $connection_to_tcp_server = 0;
	    return; 
	}
    } else {
#	print "client is defined\n";
    }


# FIRST LINE - Authentication string: The Central Server will ignore any 
# TCP traffic to this port that doesn't start with the appropriate line:
# "beacon.dast.nlanr.net:233.4.200.18:10004" (Or your CS Name, group, port)

#    print $client "$CENTRALSERVERNAME|$GROUP|$PORT|$VER\n";

    if (!defined(send($client, "$CENTRALSERVERNAME|$GROUP|$PORT|$VER\n", 0)))
    {
	print "client not defined\n";
	close($client);
	undef $client;
	return;
    }

# SECOND LINE -- Sending Beacon identifying info.    Tells us which Beacon is 
# sending this TCP report. ($^O is this Beacon's OS - That's "oh", not zero.)

# "$reports{$thisssrc} is the count of RRs we've received for that Beacon
# during the last reporting interval

    &beacon_print($client, "$thisssrc|$thishost|$thisuser|$thisip|$^O|$]|");
    if (defined $CONTACTNAME) {
	&beacon_print($client, "$CONTACTNAME|");
    } else {
	&beacon_print($client, "-1|");
    }
    if (defined $CONTACTINFO) {
	&beacon_print($client, "$CONTACTINFO|");
    } else {
	&beacon_print($client, "-1|");
    }
    if (defined $CONTACTLOCATION) {
	&beacon_print($client, "$CONTACTLOCATION|");
    } else {
	&beacon_print($client, "-1|");
    }
    if (defined $NOTIFYEMAIL) {
	&beacon_print($client, "$NOTIFYEMAIL|");
    } else {
	&beacon_print($client, "-1|");
    }
    if (defined $timestarted) {
	&beacon_print($client, "$timestarted|");
    } else {
	&beacon_print($client, "-1|");
    }
    if (defined $reports{$thisssrc}) {
	&beacon_print($client, "$reports{$thisssrc}|");
    } else {
	&beacon_print($client, "-1|");
    }
    if ($bursttest) {				# Burst testing is enabled
	&beacon_print($client, "$PREVBURSTTIME\|$BURSTTIME\|");
    } else {
	&beacon_print($client, "-1\|-1\|");
    }
    if ($silencetest) {				# Silence testing is enabled
	&beacon_print($client, "$PREVSILENCETIME\|$SILENCETIME");
    } else {
	&beacon_print($client, "-1\|-1");
    }
    &beacon_print($client, "\n");

# THIRD THROUGH Nth LINES....  Data 

# Send the actual data - Beacon $sees (This Beacon) sends the data 
# it's receiving from Beacon $seen
    my $r_ssrc;

SSRC:  foreach $r_ssrc (keys %host_lookup) {

# Skip incomplete or partial entries
	   if (! defined $host_lookup{$r_ssrc} || $host_lookup{$r_ssrc} eq "New") {
	       next SSRC;
# Same thing -- Skip if we don't have a local report for r_ssrc yet.
# It's "$thisssrc" here because right now we're sending a TCP report of
# what *this* Beacon sees.
	   } elsif (! defined $stats{$thisssrc}{$r_ssrc}) {
	       next SSRC;
	   }

# Only show values we actually have... (Theoretically redundant check here)
	   if (defined $stats{$thisssrc}{$r_ssrc}) {

	       &beacon_print($client, "$DATALINE\|");	# data[0] = "1", flag for a data line

		   &beacon_print($client, "$r_ssrc\|");		# data[1] = RR ssrc being reportED on

		   if (defined $host_lookup{$r_ssrc}) {	# data[2] = Hostname of RR
		       &beacon_print($client, "$host_lookup{$r_ssrc}\|");
		   } else {
		       &beacon_print($client, "-1\|");
		   }
	       if (defined $ip_lookup{$r_ssrc}) {		# data[3] = IP of RR
		   &beacon_print($client, "$ip_lookup{$r_ssrc}\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }

	       if (defined $stats{$thisssrc}{$r_ssrc}[$FRACT_LOST]) {		# data[4]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$FRACT_LOST]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$TOTAL_LOST]) {		# data[5]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$TOTAL_LOST]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$JITTER]) {			# data[6]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$JITTER]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$LAST_SEQ]) {		# data[7]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$LAST_SEQ]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$TIMESTAMP]) {		# data[8]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$TIMESTAMP]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$RTT]) {				# data[9]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$RTT]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$PREV_LOST]) {		# data[10]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$PREV_LOST]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$PREV_SEQ]) {		# data[11]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$PREV_SEQ]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$RTT_COUNT]) {		# data[12]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$RTT_COUNT]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       if (defined $stats{$thisssrc}{$r_ssrc}[$RTT_TOTAL]) {		# data[13]
		   &beacon_print($client, "$stats{$thisssrc}{$r_ssrc}[$RTT_TOTAL]\|");
	       } else {
		   &beacon_print($client, "-1\|");
	       }
	       &beacon_print($client, "\n");


# This Beacon is not receiving any reports from Beacon $r_ssrc
	   } else {
# Who do they see? 
	       &beacon_print($client, "$DATALINE\|$r_ssrc\|");
# Indicate we didn't see them
	       &beacon_print($client, "-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\|-1\n");
	   }
       }
       &beacon_print($client, $ENDMESSAGE); 

  return;
} # send_central_report



##-----------------------------------------------------------------------------
#
# receive_central_reports - Receive Central Server reports sent by Beacons via TCP
#
# Takes		- Nothing
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub receive_central_reports() {
  my @ready;
  my $fh;
  my $newsock; 
  my $line;
  my @lines;
  my @ssrc_lookup;
  my @data;

  my $s_ssrc;
  my $hostname;
  my $sortname;
  my $user;
  my $ip;
  my $os;
  my $perlver;
  my $contactname;
  my $contactinfo;
  my $contactloc;
  my $notifyemail;
  my $timestarted;
  my $rrcount;
  my $btest;
  my $pbtest;
  my $stest;
  my $pstest;

            
  # As long as there's data pending on the connection

  if (!$select) {
      print "select screwed\n";
      sleep(10);
      return;
  }

  while (@ready = $select->can_read()) {
      foreach $fh (@ready) {
	  if($fh == $server) {
		# Create a new socket
#	      print "Adding client\n";
	      $newsock = $server->accept;
	      $select->add($newsock);
	  } else {
#   print "Reading from client\n";
	      
#	      @lines = <$fh>;
#	      print "Read from client\n";

#	      if (eof($fh)) {
#		  $select->remove($fh);
#		  close($fh);
#		  next;
#	      } 
	      undef(@lines);
	      while (defined ($line = <$fh>) && ($line ne $ENDMESSAGE)) {
#		  print "push\n";
		  push(@lines, $line);
	      }

    # "scalar(@lines) is just the length of @lines -- Ie, loop for all lines 
    # in the array.
    my $ii=0;   # Simple linecounter for receiving report       
	while ($ii < scalar(@lines)) {
        chomp $lines[$ii];      # Whack trailing line return
            
        # First line - Authenticate!  Is this valid Beacon TCP traffic? 
        if ($ii == 0) {
			my $check = $CENTRALSERVERNAME."|".$GROUP."|".$PORT. "|".$VER;
			if ($lines[0] ne $check) {	# Non-Beacon traffic 
				print "Receive tossing \"$lines[0]\"\n";	# DEBUG - MITCH
			    $select->remove($fh);
			    close($fh) || die ("Closing Non-Beacon TCP socket died" );
			    return;
			} else {
#                        print "Good report coming in....\n";
			}

        # Second line -- Who is sending this report?
	} elsif ($ii == 1) {
            @data = split /\|/, $lines[$ii];
			$s_ssrc			= $data[0];		# Sending SSRC
			$hostname		= lc($data[1]);		# Sending Hostname
			$sortname		= &get_sortname($hostname, $s_ssrc);
			$user			= $data[2];		# Sending User
			$ip				= $data[3];		# Sending IP
			$os				= $data[4];		# Sending OS
			$perlver		= $data[5];		# Sending Perl Version
			$contactname	= $data[6];		# Sending Contact Name
			$contactinfo	= $data[7];		# Sending Contact Info
			$contactloc		= $data[8];		# Sending Contact Location
			$notifyemail	= $data[9];		# Email for Alarms/Notifications
			$timestarted	= $data[10];	# Start time in Epoch seconds
			$rrcount		= $data[11];	# Sending Beacon's Interval RR Count
			$pbtest			= $data[12];	# Previous burst test time
			$btest			= $data[13];	# Next burst test time
			$pstest			= $data[14];	# Previous silence test time
			$stest			= $data[15];	# Next silence test time
			


			$tcp_host_lookup{$s_ssrc}	= $hostname;
			$tcp_sort_lookup{$s_ssrc}	= $sortname;
			$tcp_ip_lookup{$s_ssrc}		= $ip;
			$tcp_ssrc_lookup{$sortname}	= $s_ssrc;

			$tcp_meta{$s_ssrc}[$USER]	= $user;
			$tcp_meta{$s_ssrc}[$OS]		= $os;
			$tcp_meta{$s_ssrc}[$PERLVER]= $perlver;
			$tcp_meta{$s_ssrc}[$NAME]	= $contactname;
			$tcp_meta{$s_ssrc}[$INFO]	= $contactinfo;
			$tcp_meta{$s_ssrc}[$LOC]	= $contactloc;
			$tcp_meta{$s_ssrc}[$NOTIFY]	= $notifyemail;
			$tcp_meta{$s_ssrc}[$START]	= $timestarted;	# When local started
			$tcp_meta{$s_ssrc}[$LAST_HEARD] = time;	# Last heard from here
			$tcp_meta{$s_ssrc}[$PBTEST]	= $pbtest;	# Previous Burst test time
			$tcp_meta{$s_ssrc}[$BTEST]	= $btest;	# Next Burst test time
			$tcp_meta{$s_ssrc}[$PSTEST]	= $pstest;	# Previous Silence test time
			$tcp_meta{$s_ssrc}[$STEST]	= $stest;	# Next Silence test time

			$tcp_reports{$s_ssrc}		= $rrcount;

		# Third line and beyond -- Actually receiving data here
		} else {

			@data = split /\|/, $lines[$ii];

			if ($data[0] == $DATALINE) {
				my $r_ssrc	= $data[1];
				
				# data [2] = RR hostname
				# data [3] = RR IP

				# assign it to the output hash
				$tcp_stats{$s_ssrc}{$r_ssrc}[$FRACT_LOST]	= $data[4];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST]	= $data[5];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$JITTER]		= $data[6];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ]		= $data[7];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$TIMESTAMP]	= $data[8];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$RTT]			= $data[9];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$PREV_LOST]	= $data[10];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ]		= $data[11];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT]	= $data[12];
				$tcp_stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL]	= $data[13];

				# DEBUG
				if (! defined $tcp_stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST]) {
					printf "RECEIVE_TCP - 0x%08x | 0x%08x: ", $s_ssrc, $r_ssrc;
					print "total_lost not defined!\n";
				}
				if (! defined $tcp_stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ]) {
					printf "RECEIVE_TCP - 0x%08x | 0x%08x: ", $s_ssrc, $r_ssrc;
					print "last_seq not defined!\n";
				}
				if (! defined $tcp_stats{$s_ssrc}{$r_ssrc}[$PREV_SEQ]) {
					printf "RECEIVE_TCP - 0x%08x | 0x%08x: ", $s_ssrc, $r_ssrc;
					print "prev_seq not defined!\n";
				}
				if (! defined $tcp_stats{$s_ssrc}{$r_ssrc}[$PREV_LOST]) {
					printf "RECEIVE_TCP - 0x%08x | 0x%08x: ", $s_ssrc, $r_ssrc;
					print "prev_lost not defined!\n";
				}
				if (! defined $tcp_stats{$s_ssrc}{$r_ssrc}[$RTT]) {
					printf "RECEIVE_TCP - 0x%08x | 0x%08x: ", $s_ssrc, $r_ssrc;
					print "rtt not defined!\n";
				}
				# END DEBUG

			} elsif ($data[0] == $DELETETCPENTRY) {
				# DEBUG
				if ($DEBUG > 1) {
					print "Central Server received DELETE signal for ";
					printf "0x%08x\n", $s_ssrc;
				}
				# END DEBUG

				&delete_tcp_entry($s_ssrc);	# Delete TCP copy
				$select->remove($fh);
				close($fh);

			} else {    # something WRONG...
				print "ILLEGAL VALUE DURING receive_central_reports, $data[0]...\n";
			}

		}
		$ii++;              # Next line
	}
#  $select->remove($fh);
#                      close($fh);
	      
	  }
      }
  }
  return;

} # receive_central_reports



##-----------------------------------------------------------------------------
#
# delete_tcp_entry	- Receive Central Server reports sent by Beacons via TCP
#
# Takes		- SSRC of TCP entry to delete
#
# Returns	- Nothing
#
##-----------------------------------------------------------------------------

sub delete_tcp_entry() {
  my $ssrc = shift(@_);

  # DEBUG
  if ($DEBUG > 1) {
 	print "Attempting to delete SSRC ";
	printf "0x%08x\n", $ssrc;
  }
  # END DEBUG


  my ($s_name, $r_name);
  foreach $s_name (keys %tcp_ssrc_lookup) {
	foreach $r_name (keys %tcp_ssrc_lookup) {
		my $s_ssrc = $tcp_ssrc_lookup{$s_name};
		my $r_ssrc = $tcp_ssrc_lookup{$r_name};

		if ($s_ssrc == $ssrc) {
			delete $tcp_stats{$s_ssrc};
		}
		if ($r_ssrc == $ssrc) {
			delete $tcp_stats{$r_ssrc};
		}
	}   
  }
  
  my $ii;

  # Find the correct key... 
  foreach $ii (keys %tcp_ssrc_lookup) {
	if ($tcp_ssrc_lookup{$ii} == $ssrc) { 
		delete $tcp_ssrc_lookup{$ii};     # Got it -- Whack it!
	}

  }

  if (defined $tcp_meta{$ssrc} ) {
	delete $tcp_meta{$ssrc};    # Delete tcp meta-data hash, too.
  } 
 
  if (defined $tcp_sort_lookup{$ssrc} ) {
	delete $tcp_sort_lookup{$ssrc};
  } 
 
  if (defined $tcp_host_lookup{$ssrc} ) {
	delete $tcp_host_lookup{$ssrc};
  } 
 
  if (defined $tcp_ip_lookup{$ssrc} ) {
	delete $tcp_ip_lookup{$ssrc};
  } 
 
  if (defined $tcp_reports{$ssrc} ) {
	delete $tcp_reports{$ssrc};
  } 
 
  # DEBUG
  if ($DEBUG > 1) {
 	print "Leaving delete_tcp_entry\n";
  }
  # END DEBUG
  return;

} # delete_tcp_entry



##-----------------------------------------------------------------------------
#
# get_time32	- Gets middle 32-bit time value from gettimeofday
#
# Takes		- Nothing
#
# Returns	- ntp32 part of gettimeofday
#
#
##-----------------------------------------------------------------------------

sub get_time32() {
    my $sec;
    my $usec;
    my $time32;

    ($sec, $usec) = gettimeofday();

	# usec now in units of 2^32 -1
	$usec = ($usec << 12) + ($usec << 8) - (($usec * 3650) >> 6);

	# Grab the middle 32 bits of gettimeofday
    $time32 = ((($sec)  & 0x0000ffff) << 16) | ((($usec) & 0xffff0000) >> 16);

    return $time32;

} # get_time32




##-----------------------------------------------------------------------------
#
# bursttest	- Sends 100-packet burst of RTP traffic into the group
#
# Takes		- Nothing
#
# Returns	- Nothing
#
#
##-----------------------------------------------------------------------------

sub bursttest() {

  #print "In subroutine bursttest!\n";

  for (my $dd=0; $dd < $BURSTCOUNT; $dd++) {

	send_rtp();						# Send RTP/RTCP traffic out

	# Pause just a tiny bit to allow any other needed processing to take place
	usleep($BURSTSLEEP);

  }

  return;

} # bursttest


##-----------------------------------------------------------------------------
#
# get_next_testtime	- Gets the next time for a burst test to take place
#
# Takes		- Nothing
#
# Returns	- Epoch time of next burst test - 2 to  6 hours from now.
#
#
##-----------------------------------------------------------------------------

sub get_next_testtime() {
  # TESTWINDOW = 14400 seconds = 240 minutes = 4 hours
  # Get random number of seconds between zero and four hours
  my $randval = int(rand $TESTWINDOW);
  my $temp = &ctime(time);
  chomp $temp;
  return (time + $TWOHOURS + $randval);	# 2 hours + (0 to 240 minutes)

} # get_next_testtime()



##-----------------------------------------------------------------------------
#
# send_rtp	- Send RTP/RTCP traffic into the group
#
# Takes		- Nothing
#
# Returns	- Nothing
#
#
##-----------------------------------------------------------------------------

sub send_rtp() {

  $rtp_ts = get_time32();		# Set timestamp for this event

  # Send RTP data into the group -- Minimum possible, allows us to listen.
  rtp_send_data($session, $rtp_ts, 0, 0, $buf, length($buf), 0, 0, 0);
  rtp_update($session);		# Keep the RTP database up to date
  
  # Send RTCP control traffic -- Actually particpate in the group.
  # Without this rtp_send_ctrl call, we're just listening.
  rtp_send_ctrl($session, $rtp_ts);

} # send_rtp() 




##-----------------------------------------------------------------------------
#
# remove_timedout_beacons	- Check for Beacons that the Central Server
#                             hasn't heard from in X seconds
#
# Takes		- Nothing
#
# Returns	- Nothing
#
#
##-----------------------------------------------------------------------------

sub remove_timedout_beacons() {

  my $now = time;
  # if we haven't heard a TCP report from a given Beacon in too long...
  #print "Made it to remove_timedout_beacons\n";

  my $ii;
  my $count = 0;
  foreach $ii (keys %tcp_meta) {

	$count++;
	my $diff = $now - $tcp_meta{$ii}[$LAST_HEARD];
#    print "diff = $diff, ii = $ii\n";

#	printf "Diff for SSRC 0x%08x = %d.\n", $ii, $diff;
	if ($DEBUG > 1 ) {
		printf "Diff for SSRC 0x%08x = %d.\n", $ii, $diff;
	}

	# If we haven't gotten a report from a Beacon in TIMEOUT_DELETE
	# seconds or more, remove it from the central server matrix
	if ($diff > $TIMEOUT_DELETE ) {
		if ($DEBUG > 1 ) {
			printf "Timeout Delete of SSRC 0x%08x.\n", $ii;
		}
		&delete_tcp_entry($ii);	# Delete TCP copy
	}
  }


  if ($DEBUG > 1 ) {
	print "Leaving remove_timedout_beacons, count = $count\n";
  }

} # remove_timedout_beacons() 





##-----------------------------------------------------------------------------
#
# MAIN		- The whole 8.2296 meters     ;-)
#
# Takes		- Nothing
#
# Returns	- Nothing
#
# This is the start of the main routine.
#
##-----------------------------------------------------------------------------

# Trap exiting or being stopped so we can clean up before exiting
$SIG{INT}   = \&pre_exit_cleanup;
$SIG{TERM}  = \&pre_exit_cleanup;
$SIG{CHLD}  = 'IGNORE'; #XXX should re-spawn server
$SIG{PIPE}  = 'IGNORE'; #Ugly, but Darwin doesn't understand MSG_NOSIGNAL
#$SIG{PIPE}  = 'sigpipe_catcher';

get_opts();

print "\nGetting configuration information from file \"$CONFIGFILE\".\n";

# fork() the process into the background?
if ($background) {
	if (fork()) {
		print "\n\nBeacon now running in the background...\n\n";
		exit();
	}
}

$starttime = &ctime(time);		# Mark the current time as we start
chomp $starttime;				# Remove the trailing line return

# Temporary PID file, so restart knows what it's killing.
my $pidtokill = "";

kill_existing_pid;    # Kill the existing PID file, but don't exit

create_new_pid;       # Generate the new PID file

# Open the RPT session, the trailing "0" argument is "user data", which
# is curently unused, but needs to be supplied.
if (! defined $interface) {
	$session	= beacon_init($GROUP, $PORT, $PORT, $TTL, $BANDWIDTH, 0);
	print "Opening session on default interface.\n";
} else {
	$session	= beacon_init_if($GROUP, $interface, $PORT, $PORT, $TTL, $BANDWIDTH, 0);
	print "Opening session on interface \"$interface\".\n";
}
if (! defined $session) {
	die "Unable in initialize RTP session for this Beacon!\n";
}

# Get username and hostname from the local environment, if possible
my $user  = $ENV{'USER'} || `who am i`;
if ($userid) {
    $user = $userid;	# Change to the specified (non-privileged) user
}

my $host = lc(hostname);		# Use Sys::Hostname to get good hostname
my $host2 = lc(Net::Domain::hostfqdn()) || die "Unable to get fqdn: $!\n";
# if Net::Domain resolves better than Sys::Hostname, use it instead....
if (length($host2) > length($host)) {
	$host = $host2;
}

chomp $user;			# Whack any trailing line returns
chomp $host;
$thishost	= $host;
$thisuser	= $user;

my $packed = gethostbyname($host);
if (! defined $packed) {			# Couldn't get it - Mark it bad
	$thisip = "UNKN";
} else {							# Unpack it into a string var
	$thisip = inet_ntoa($packed);	# "141.142.2.168"
}

# Do the best job we can do for getting FQDN for  the hostname
my $lookup = gethostbyaddr(inet_aton($thisip), AF_INET);
if (defined $lookup) {		# Only update if it worked
	$thishost	= $host = $lookup;
} else {
	$thishost	= $thisip;
}

# If host still "UNKN" at this point, things are too confused to continue
if ($thishost eq "UNKN") {
	die "Unable to resolve hostname -- Please check your system 
		configuration to verify your networking files are set up correctly.\n";
}


# Get the SSRC for this Beacon
my $ssrc		= rtp_my_ssrc($session);
$thissession	= $session;	# Mark who we are for use later
$thisssrc		= $ssrc;		# Mark who we are for use later

# Create a sortname using hostname and SSRC
my $localsortname = &get_sortname($host, $thisssrc);

# Add the new Beacon to the hash tables - This makes it real.
&add_beacon($localsortname, $host, $thisip, $thisssrc);

# END OF LOCAL ADD

# Show who we are
print "\n";
printf "Starting Beacon \"%s-%d\" as \"%s\" on %s.\n", $VER, $SUBVER, $user, $starttime;
printf "This host is \"%s\", ssrc = 0x%08x, PID = %d.\n", $host, $ssrc, $$;
print "Multicast Group = $GROUP, Port = $PORT, TTL = $TTL.  OS = \"$^O\"\n";
if ($noshutdownmsg) {
  print "No shutdown message will be written to HTML files when Beacon is shut down.\n";
}
if ($DEBUG > 0) {
  print "Starting with DEBUG LEVEL of $DEBUG.\n";
}

print "\nOutput files being written to \"$outputdir/\"\n\n";

# Set location, name, tool, and machine name info for RTP stream
rtp_set_sdes($session, $ssrc, $Net::Multicast::Beacon::RTCP_SDES_LOC, 
  "$CONTACTLOCATION", length("$CONTACTLOCATION"));
rtp_set_sdes($session, $ssrc, $Net::Multicast::Beacon::RTCP_SDES_NAME, 
  $user, length($user));
rtp_set_sdes($session, $ssrc, $Net::Multicast::Beacon::RTCP_SDES_TOOL, 
  "$0", length("$0"));
rtp_set_sdes($session, $ssrc, $Net::Multicast::Beacon::RTCP_SDES_CNAME, 
  $host, length($host));

if ($becentralserver) {
  print "Listening as a Central Server - TCP Unicast reports coming back to port $SERVERTCPPORT.\n";

# Establish the listening connection for the central server...

  $server = new IO::Socket::INET(Listen => SOMAXCONN,
      LocalPort => $SERVERTCPPORT,
      Reuse => 1);
  if (! defined $server) {
    print "Couldn't bind TCP server ";
  } else {
    print "Listening on port $SERVERTCPPORT...\n";
    $select = new IO::Select($server) || die "Can't get select for $!\n";

# Get flags and make this connection non-blocking...
    my $flags = fcntl($server, F_GETFL, 0)
      || die "Can't get flags for the Central Server socket: $!\n";
    $flags = fcntl($server, F_SETFL, $flags | O_NONBLOCK)
      || die "Can't set flags for the Central Server socket: $!\n";
  }

  my $line;

  die "Can't fork $!\n" unless defined($childpid = fork());
  if ($childpid) {
    close($server);
    undef($server);
  } else {
    $SIG{INT}   = \&child_cleanup;
    $SIG{ALRM}  = \&child_notify;
#    print "Listening on port $SERVERTCPPORT...\n";
#    $select = new IO::Select($server) || die "Can't get select for $!\n";

# Get flags and make this connection non-blocking...
#    my $flags = fcntl($server, F_GETFL, 0)
#      || die "Can't get flags for the Central Server socket: $!\n";
#    $flags = fcntl($server, F_SETFL, $flags | O_NONBLOCK)
#      || die "Can't set flags for the Central Server socket: $!\n";
    while (1) {
      &receive_central_reports();
#      sleep(1);
    } 
  }
  
# They want to save flat text history information
  if ($writehistory) {
    print "Writing flat-text CSV history data out to history ";
    print "file \"$HISTORYFILE\".\n";
  }
# They want to clear the history file before starting
  if ($erasehistory) {
    if (-e $outputdir . "/" . $HISTORYFILE) {      # Does it exist?
      unlink $outputdir . "/" . $HISTORYFILE || 
	die ("Couldn't clear HISTORYFILE" );
      print "Previous history file \"$outputdir/$HISTORYFILE\" ";
      print "deleted. Starting clean.\n";
    } else {
      print "No previous history file to erase.\n";
    }
  }
}

if (defined $NOTIFYEMAIL) {
  print "\n";
  print "Alarm/Notification notices will be sent to $NOTIFYEMAIL\n";
  print "when those features are implemented.\n"
}

if ($bursttest) {
  $BURSTTIME = get_next_testtime();
  my $BURSTSHOW = &ctime($BURSTTIME);
  chomp $BURSTSHOW;
  print "Burst testing enabled.  First Burst test at $BURSTSHOW\n";
}

if ($silencetest) {
  $SILENCETIME = get_next_testtime();
  my $SILENCESHOW = &ctime($SILENCETIME);
  chomp $SILENCESHOW;
  print "Silence testing enabled.  First Silence test at $SILENCESHOW\n";
}

if (defined $CENTRALSERVERNAME && $CENTRALSERVERNAME) {
  print "\n";
  print "Go to http://$CENTRALSERVERNAME to see this Beacon's output.\n";
}

print "\n";

my $rr ;					# Receiver report pointer
my $i ;						# work var
my $u;						# user info
my $h;						# hostname

xmemdmp();					# Update memory table

my $now = time;           # Get the current timestamp in seconds
my $now2;

$timestarted	= $now;

my $timeout  = rtp_make_timeval(0,0);	# Create a timevalue of zero

# Give silence test message?  Start with "yes".....
my $silencemsgflag = 1;


# Main loop
while (1) {

# If silence testing is turned on and it's past time to start the test, 
  if ($silencetest && (time > $SILENCETIME)) {

	# If it's still within the test interval, don't transmit
	if ((time - $SILENCETIME) < $SILENCEINTERVAL) {
		if ($silencemsgflag) {
			print "Current silence test in progress.\n";
			$silencemsgflag = 0;
		}

	# If it's beyond the test interval, get the new interval
	} else {
		# Show when the next test is
		$PREVSILENCETIME = $SILENCETIME;

		$SILENCETIME = get_next_testtime();

		my $SILENCESHOW = &ctime($SILENCETIME);
		my $PREVSILENCESHOW = &ctime($PREVSILENCETIME);
		chomp $SILENCESHOW;
		chomp $PREVSILENCESHOW;
		my $temp = &ctime(time);
		chomp $temp;
		print "$temp: Prev Silence test was at $PREVSILENCESHOW \n";
		print "\tNext Silence test at $SILENCESHOW\n";
		$silencemsgflag = 1;	# Give message first time through next pass
	}



  # Not in middle of silence test, or not doing silence tests at all.
  } else {
	
	send_rtp();						# Send RTP traffic out

  }


  $rtp_ts = get_time32();

  while (rtp_recv($session, $timeout, $rtp_ts)) { ; }

# Process incoming RTP events, looking for RRs
  while($event = beacon_get_next_event()) {
	if($event->{type} == $RX_RR) {			# If this is a Receiver Report...
		my $timestamp = $event->{time};
		my $rr = $event->{rr};
		my $s_ssrc = $event->{ssrc};	# SSRC of the the Beacon reporting
		my $r_ssrc = $rr->{ssrc};		# SSRC of Beacon being reported ON
		# fract_lost scaled down from 0-255 to 0-100 (endian byte order issues)
		my $fract_lost = $rr->{fract_lost};
		my $total_lost = $rr->{total_lost};
		# Get raw value
		my $jitter = $rr->{jitter};
		# Bottom 16 bits is running counter, top 16 bits is extended counter,
		# AKA, the number of times the lower 16 bit counter has overflowed.
		$jitter = (($jitter & 0xffff0000) >> 16) + 
			($jitter & 0x0000ffff)/65536.0;
		#$jitter = int($jitter * 1000);	# Scale it to milliseconds
		$jitter = int($jitter);	# Already in milliseconds
		my $last_seq = $rr->{last_seq};
		my $lsr = $rr->{lsr};
		my $dlsr = $rr->{dlsr};
		my $rtt;					# For use down below \/

		# Track number of reports received for this SR during last interval
		if (defined $reports{$s_ssrc}) {	# Subsequent reports for SR
			$reports{$s_ssrc}++;
		} else {							# First report - Initialize
			$reports{$s_ssrc} = 1;
		}


		# The is the Human contact information from SDES string

		# These are for S_SSRC - The Beacon doing the seeing, not the one seen
		# $h == hostname  ie, "yendi.ncsa.uiuc.edu"
		my $h = lc(rtp_get_sdes($session, $event->{ssrc}, 
			$Net::Multicast::Beacon::RTCP_SDES_CNAME));

		#$u = rtp_get_sdes($session, $event->{ssrc}, 
		#	$Net::Multicast::Beacon::RTCP_SDES_NAME);
		#print "U = \"$u\"\n";

		# $h being defined indicates we have hostname from SDES for this SSRC.
		# $host_lookup{$s_ssrc} eq "New" indicates Beacon has beem created, but 
		# not initialized yet.  At this point, we now have enough 
		# information to actually add this Beacon, so do so.
		if (defined $h && (defined $host_lookup{$s_ssrc}) && 
			($host_lookup{$s_ssrc} eq "New")) {

			# Get the IP address of the hostname given in $h
			my $hostip;
			my $packed = gethostbyname($h);
			if (! defined $packed) {		# Couldn't get it - Mark it bad
				$hostip = "UNKN";
			} else {						# Unpack it into a string var
				$hostip = inet_ntoa($packed);
			}

			# Create a sortname using hostname and SSRC
			my $sortname = &get_sortname($h, $s_ssrc);

			# Add the new Beacon to the hash tables - This makes it real.
			&add_beacon($sortname, $h, $hostip, $s_ssrc);
		}

		# Got live entries from here down

		my $datetime = &ctime($timestamp);
		chomp $datetime;

		# Determine RTT --- JSE
		my $tmp_floattime = (($timestamp & 0xffff0000) >> 16) + (($timestamp & 0x0000ffff) << 16) / $TWOTOTHETHIRTYSECONDMINUSONE;
		my $tmp_floatlsr = (($lsr & 0xffff0000) >> 16) + (($lsr & 0x0000ffff) << 16) / $TWOTOTHETHIRTYSECONDMINUSONE;
		my $tmp_floatdlsr = $dlsr / 65536.0;
		$rtt = int(($tmp_floattime - $tmp_floatlsr - $tmp_floatdlsr) * 1000);

		# Assign current RR's stats to the hash table
		$stats{$s_ssrc}{$r_ssrc}[$FRACT_LOST]	= $fract_lost;

		$stats{$s_ssrc}{$r_ssrc}[$TOTAL_LOST]	= $total_lost;
		$stats{$s_ssrc}{$r_ssrc}[$LAST_SEQ]		= $last_seq;
		$stats{$s_ssrc}{$r_ssrc}[$TIMESTAMP]	= $timestamp;
		$stats{$s_ssrc}{$r_ssrc}[$JITTER]		= $jitter;
		$stats{$s_ssrc}{$r_ssrc}[$RTT]			= $rtt;


		# Track running RTT total for interval calculation of RTT
		if (! defined $stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL]) {
			$stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL] = $rtt;
			$stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT] = 1;
		
		} else {
			$stats{$s_ssrc}{$r_ssrc}[$RTT_TOTAL] += $rtt;
			$stats{$s_ssrc}{$r_ssrc}[$RTT_COUNT]++;
		}


	} elsif ($event->{type} == $SOURCE_CREATED) {
		my $ssrc = $event->{ssrc};
		$host_lookup{$ssrc}	= "New";	# Create unfinished entry for Beacon

	} elsif ($event->{type} == $SOURCE_DELETED) {
		my $ssrc = $event->{ssrc};
		&del_beacon($ssrc);			# Delete this Beacon
	} 

	beacon_free_event($event);		# Done with it -- Free this event
  }

  $now2 = time;           	# Get the current timestamp in seconds


  if (($now2 - $now) > $WEBREFRESH) {	# Has it been $WEBREFRESH seconds yet?

      if ($becentralserver) {

			#print "First becentralserver check at WEBREFRESH seconds.\n";

            # alert child process to update central server pages
            kill("ALRM", $childpid);
      }

# Send reports back to the central server, if configured for that
# NOTE: This must be done before the calls below to html_output, because
# html_output will clear RTT_COUNT and RTT_TOTAL for the next interval
# JSE XXX fix this
      if (defined $CENTRALSERVERNAME) {
	&send_central_report();
      }


# Update the web pages
      &html_update_local();

#	&html_output("fract_lost", 10, 30, 100, \%ssrc_lookup, \%ip_lookup, \%sort_lookup, \%reports, \%stats);
#	&html_output("local_loss", 10, 30, 100, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);
#	&html_output("local_rtt", 100, 500, 5000, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);
#	&html_output("local_jitter", 200, 250, 500, \%ssrc_lookup, \%ip_lookup, \%sort_lookup,\%reports,  \%stats);

	if ($becentralserver) {
		# Check for timedout Beacons and remove
		#&remove_timedout_beacons();


		# Filter Blind Beacons out of the matrix
#		&html_prefilter(\%tcp_ssrc_lookup, \%tcp_host_lookup, \%tcp_stats);
		
#		&html_update_central();

#		&html_output("central_loss", 10, 30, 100, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);
#		&html_output("central_rtt", 100, 500, 5000, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);
#	&html_output("central_jitter", 200, 250, 500, \%tcp_ssrc_lookup, \%tcp_ip_lookup, \%tcp_sort_lookup,\%tcp_reports,  \%tcp_stats);

#		if ( $DEBUG > 0 ) {
#			&contactinfo_output();
#		}

#		&beacon_info_output();

		# They want history output
#		if ($writehistory) {
#			&history_output();		# Generate flat-text CSV of stats
#		}
	}

	# Clear report counters for next pass
	undef %reports; #XXX where does this go ??

#	&host_lookup_output(\%host_lookup, "host_lookup");
#	&sort_lookup_output(\%sort_lookup, "sort_lookup");
#	&ip_lookup_output(\%ip_lookup, "ip_lookup");
#	&ssrc_lookup_output(\%ssrc_lookup, "ssrc_lookup");
#	&stats_table_output(\%stats, \%host_lookup, "stats_lookup");

#	if ($becentralserver) {
#		&host_lookup_output(\%tcp_host_lookup, "tcp_host_lookup");
#		&sort_lookup_output(\%tcp_sort_lookup, "tcp_sort_lookup");
#		&ip_lookup_output(\%tcp_ip_lookup, "tcp_ip_lookup");
#		&ssrc_lookup_output(\%tcp_ssrc_lookup, "tcp_ssrc_lookup");
#		&stats_table_output(\%tcp_stats, \%tcp_host_lookup, "tcp_stats_lookup");

# MITCH, 7/19/05 - Moved to "remove_timedout_beacons"
# XXX move to child
		# if we haven't heard a TCP report from a given Beacon in too long...
#		my $ii;
#  		foreach $ii (keys %tcp_meta) {
#			my $diff = $now2 - $tcp_meta{$ii}[$LAST_HEARD];
#
#			# If we haven't gotten a report from a Beacon in TIMEOUT_DELETE
#			# seconds or more, remove it from the central server matrix
#			if ($diff > $TIMEOUT_DELETE ) {
#				if ($DEBUG > 0 ) {
#					printf "Timeout Delete of SSRC 0x%08x.\n", $ii;
#				}
#				&delete_tcp_entry($ii);	# Delete TCP copy
#			}
#		}
#	}

	$now = $now2;           # Reset the clock
  }

  my $skipped =  0;		# Did we skip the Burst test?

  # If we're doing burst testing and it's time for the next test....
  if ($bursttest && (time > $BURSTTIME)) {
  	if ($silencetest && (time > $SILENCETIME)) {
		print "Burst test fell within Silence test -- Skipping Burst test.\n";
		$skipped = 1;	# We skipped the burst test
	} else {
		bursttest();
	}

	$PREVBURSTTIME = $BURSTTIME;	# Save previous time

	$BURSTTIME = get_next_testtime();	# Schedule next time

	# Show when the next test is
	my $BURSTSHOW = &ctime($BURSTTIME);
	my $PREVBURSTSHOW = &ctime($PREVBURSTTIME);
	chomp $BURSTSHOW;
	chomp $PREVBURSTSHOW;
	my $temp = &ctime(time);
	chomp $temp;
	print "$temp: Prev Burst test was ";
	if ($skipped) {
		print "SKIPPED.\n";
	} else {
		print "at $PREVBURSTSHOW \n";
	}
	print "\tNext Burst test at $BURSTSHOW\n";
  }

  usleep($SLEEP * 1000);	# Scale the wait based on # of beacons?
}


xmemdmp();					# Update the memory table
rtp_send_bye($session);		# Say we're leaving
rtp_done($session);			# Leave

&drain_queue;				 # Drain the queue now that we're leaving


xmemdmp();					# Update the memory table
exit(0);

# This package permits Tieing of STDOUT to
# syslog. When *STDOUT is tied to this package
# then all printed text (to STDOUT) will appear
# in the syslog. All newlines are preserved.
# In addition printing of partial line components
# is supported (ie: print "a" ; print "b\n" ;
# will write "ab\n" to the syslog.
#
package Tie::Syslog;

use strict;

use Sys::Syslog;

sub TIEHANDLE {

my $class = shift;
my $self = {};

openlog( @_ );

$self->{text} = '';

return bless $self, $class;
}

sub PRINTF {
my $self = shift;
my $format = shift;
$self->PRINT( sprintf( $format, @_ ));
}

sub PRINT {

my $self = shift;

$self->{text} .= shift ;

while ( $self->{text} =~ m/^(.*?)\n(.*)$/s ) {
	$self->{text} = $2;
	syslog('info','%s', $1 );
	}

return;
}

sub CLOSE {
my $self = shift;

# If there is any text in the buffer then ensure it is written ..
if ( length( $self->{text} ) > 0 ) {
	syslog('info','%s', $self->{text} );
	}
closelog();
}

# END OF FILE
