#!/usr/local/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 Socket6; # For reverse IPv6 lookup
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 = "/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> </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\"> <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();
¢ral_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;
#if group address an IPv6 address, we have to find IPv6 addresses
if ($GROUP =~ ":" ) {
my @res=getaddrinfo($host,'daytime',AF_INET6);
my($packed,$port) = getnameinfo($res[3],NI_NUMERICHOST);
my($packed2,$port2) = getnameinfo($res[3]);
if( !defined $packed) {
$thisip = "UNKN";
} else {
$thisip = $packed;
}
if (!defined $packed2) {
$thishost = $host = $packed2;
} else {
$thishost = $thisip;
}
} else {
my $packed = gethostbyname($host);
if (! defined $packed) { # Couldn't get i t - 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;
if ( $GROUP =~ ":" ) {
my @res = getaddrinfo($h,'daytime', AF_INET6);
my ($packed,$port) = getnameinfo($res[3],NI_NUMERICHOST);
my ($packed2,$port2) = getnameinfo($res[3]);
if(defined $packed) {
$hostip = $packed;
}
if(defined $packed2) {
$hostip = $packed2;
}
} else {
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
syntax highlighted by Code2HTML, v. 0.9.1