#!@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 = "@prefix@/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 () { 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 "\n"; print OUTFILE " #\n"; print OUTFILE " Hostname\n"; # Show IP addresses if ($showip) { print OUTFILE " IP Address\n"; } # Show SSRC if ($showssrc) { print OUTFILE " SSRC\n"; } # Show RR Report count if ($showreports) { print OUTFILE " RRs\n"; } for ($dd=0; $dd<$totalbeacons; $dd++) { print OUTFILE " S$dd\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 "  \n"; } } print OUTFILE "\n"; } print OUTFILE "\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 R$linecount\n"; $beacon_marker = $linecount; # Mark the "*This* Beacon" line } else { print OUTFILE "\n R$linecount\n"; } # Two columns for hostname/IP, hostname right justified, IP left justified. print OUTFILE " "; # 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 "$bold[$dd]"; # 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 "@bold"; } else { print OUTFILE "@bold"; } } print OUTFILE "\n"; # Show the reverse-lookuped IP address if ($showip) { print OUTFILE " "; 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 "Localhost"; } 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 "\n"; } # Show the SSRC in hex if ($showssrc) { print OUTFILE " "; printf OUTFILE "0x%08x", $s_ssrc; print OUTFILE "\n"; } # Show SR report count if ($showreports) { print OUTFILE " "; 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 "\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 " "; print OUTFILE "**"; #print OUTFILE "$value"; } elsif ($value == -1) { # NA value - Show a grey "NA" print OUTFILE " "; print OUTFILE "NA"; } elsif ($value < -1) { # Odd negative value print OUTFILE " "; print OUTFILE "*"; } else { # Normal case -- Show good value print OUTFILE " "; print OUTFILE "$value"; } print OUTFILE "\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 R$linecount\n"; } else { print OUTFILE "\n R$linecount\n"; } } $innercount++; } $linecount++; print OUTFILE "\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 "\n"; #--------- end top part ---- print OUTFILE "\n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE " \n"; print OUTFILE "\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 "\n"; # Visually (no pun intended) mark Blind Beacons if ($blind{$ssrc}) { print OUTFILE " "; } else { print OUTFILE " "; } # Two columns for hostname/IP, hostname right justified, IP left justified. print OUTFILE " \n"; # Show the reverse-lookuped IP address if ($showip) { print OUTFILE " \n"; } # Show the SSRC in hex print OUTFILE " \n"; # Show SR report count #if ($showreports) { # print OUTFILE " \n"; #} # User if ($tcp_meta{$ssrc}[$USER] eq "root") { # Running the Beacon as root! print OUTFILE " \n"; # Show the OS print OUTFILE " \n"; # Show the Perl Version #print OUTFILE " \n"; # Show the uptime print OUTFILE " \n"; # Show when started my $started = &ctime($tcp_meta{$ssrc}[$START]); chomp $started; print OUTFILE " \n"; # Show when last heard from my $lastheard = &ctime($tcp_meta{$ssrc}[$LAST_HEARD]); chomp $lastheard; print OUTFILE " \n"; # Contact Name print OUTFILE " \n"; # Contact Info print OUTFILE " \n"; # Contact Loc print OUTFILE " \n"; my $temp; # For testinfo fields # Next Burst Test print OUTFILE " \n"; # Next Silence Test print OUTFILE " \n"; # Previous Burst Test print OUTFILE " \n"; # Previous Silence Test print OUTFILE " \n"; #--------- end outer loop part ---- print OUTFILE "\n"; $hostnum++; } #--------- start bottom part ---- print OUTFILE "
#HostnameIP AddressSSRCUserOSUptimeStartedLast HeardContact NameContact InfoContact LocationNext Burst TestNext Silence TestPrev Burst TestPrev Silence Test
B$hostnum"; print OUTFILE "B$hostnum"; print OUTFILE ""; # 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 "$bold[$dd]"; # 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 "@bold"; } else { print OUTFILE "@bold"; } } print OUTFILE ""; 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 "Localhost"; } else { print OUTFILE "$tcp_ip_lookup{$ssrc}"; } } else { print "No IP yet.\n"; } print OUTFILE ""; printf OUTFILE "0x%08x", $ssrc; print OUTFILE ""; # if (defined $tcp_reports{$ssrc}) { # print OUTFILE "$tcp_reports{$ssrc}"; # } else { # print OUTFILE "None"; # } # print OUTFILE ""; print OUTFILE "$tcp_meta{$ssrc}[$USER]"; } else { print OUTFILE " "; print OUTFILE "$tcp_meta{$ssrc}[$USER]"; } print OUTFILE ""; print OUTFILE "$tcp_meta{$ssrc}[$OS]"; print OUTFILE ""; #print OUTFILE "$tcp_meta{$ssrc}[$PERLVER]"; #print OUTFILE ""; my $now = time; # "Now" in Epoch Seconds if ($now <= $tcp_meta{$ssrc}[$START]) { print OUTFILE "Bad Clock"; } 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 ""; print OUTFILE "$started"; print OUTFILE ""; print OUTFILE "$lastheard"; print OUTFILE ""; print OUTFILE "$tcp_meta{$ssrc}[$NAME]"; print OUTFILE ""; print OUTFILE "$tcp_meta{$ssrc}[$INFO]"; print OUTFILE ""; print OUTFILE "$tcp_meta{$ssrc}[$LOC]"; print OUTFILE ""; if ($tcp_meta{$ssrc}[$BTEST] == -1) { $temp = "Testing Turned Off"; } else { $temp = &ctime($tcp_meta{$ssrc}[$BTEST]); } print OUTFILE "$temp"; print OUTFILE ""; if ($tcp_meta{$ssrc}[$STEST] == -1) { $temp = "Testing Turned Off"; } else { $temp = &ctime($tcp_meta{$ssrc}[$STEST]); } print OUTFILE "$temp"; print OUTFILE ""; 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 ""; 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 "
\n"; print OUTFILE "\n\n"; print OUTFILE "

\n\n"; print OUTFILE "* Note: Hostnames are displayed alphabetically "; print OUTFILE "by reverse domain name.
\n"; print OUTFILE "* Note: Started and Uptime columns "; print OUTFILE "assume an accurate local clock.

\n"; if ($totalblind) { # If there are blind beacons present print OUTFILE "

\n\n"; print OUTFILE "* Note: Beacons marked with a white number on a "; print OUTFILE "blue background are \"Blind Beacons\".

\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 "\n\n"; print OUTFILE " NLANR/DAST Beacon Webview on $datetemp\n"; print OUTFILE " \n"; print OUTFILE "\n\n\n"; print OUTFILE "\n \n"; print OUTFILE " \n \n"; print OUTFILE " \n
\n"; print OUTFILE " "; print OUTFILE ""; print OUTFILE "Multicast Beacon"; print OUTFILE "\n"; print OUTFILE " v$VER-$SUBVER\n"; print OUTFILE "  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 "
\n"; print OUTFILE "
\n"; print OUTFILE "
\n"; # Write the links to the other files print OUTFILE "

\n\n"; if ($showmotd) { # Show the MOTD if flagged print OUTFILE "

\n\n$MOTD

"; } # Write the general information about this particular BeaconServer session print OUTFILE "Time: $datetemp CST | "; print OUTFILE "Page Refresh: $WEBREFRESH seconds | "; print OUTFILE "Started: $starttime | "; if ($showblind && $becentralserver && $totalblind) { print OUTFILE "Beacons: $totalbeacons | "; print OUTFILE "Blind Beacons: $totalblind
\n"; } else { print OUTFILE "Beacons: $totalbeacons
"; } print OUTFILE "Target Multicast Group: $GROUP | "; print OUTFILE "Client-to-Client (RTP) multicast traffic on "; print OUTFILE "port: $PORT, "; print OUTFILE "RTCP traffic on port: $RTCP_PORT\n"; if ($CENTRALSERVERNAME) { print OUTFILE "
TCP unicast reports going back to the Central "; print OUTFILE "Server on port $SERVERTCPPORT\n"; } print OUTFILE "

\n\n"; print OUTFILE "Central Loss | "; print OUTFILE "Local Loss | "; print OUTFILE "Fract Loss | "; print OUTFILE "Central RTT | "; print OUTFILE "Local RTT | "; print OUTFILE "Central Jitter | "; print OUTFILE "Local Jitter | "; print OUTFILE "Beacon Info"; if ($writehistory) { print OUTFILE " | "; # print OUTFILE "$HSECS-second History | "; print OUTFILE "History | "; print OUTFILE "Previous History"; } print OUTFILE "

\n"; print OUTFILE "\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 "
\n"; print OUTFILE "\n\n"; print OUTFILE "

\n\n"; print OUTFILE "Central Loss | "; print OUTFILE "Local Loss | "; print OUTFILE "Fract Loss | "; print OUTFILE "Central RTT | "; print OUTFILE "Local RTT | "; print OUTFILE "Central Jitter | "; print OUTFILE "Local Jitter | "; print OUTFILE "Beacon Info"; if ($writehistory) { print OUTFILE " | "; # print OUTFILE "$HSECS-second History | "; print OUTFILE "History | "; print OUTFILE "Previous History"; } print OUTFILE "

\n"; print OUTFILE "

\n\n"; print OUTFILE ""; print OUTFILE "Diagnosing problems with your multicast setup |\n"; print OUTFILE ""; print OUTFILE "Contributed code and patches

\n"; print OUTFILE " \n"; print OUTFILE " \n"; # Show blind Beacons here if ($becentralserver && $totalblind) { print OUTFILE "


\n"; print OUTFILE "\n"; print OUTFILE "Blind Beacons -- 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 by \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 "\n"; print OUTFILE "
\n"; print OUTFILE "

\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 "

\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 "

\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 "

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

\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 "

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

\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 "

\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 "

\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 "

\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 "

"; } 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.

\n"; } print OUTFILE "

\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 "Please note this list can only be posted to by \n"; print OUTFILE "SUBSCRIBERS, in order to keep it spam-free.\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 ""; print OUTFILE "http://archive.ncsa.uiuc.edu/lists/beacon.\n"; print OUTFILE "

\n"; print OUTFILE "

\n"; print OUTFILE "Another way to contact us is to use the \n"; print OUTFILE "DAST \n"; print OUTFILE "contact webform.\n"; print OUTFILE "\n\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 = ; 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 "\n\n"; print OUTFILE " NLANR/DAST Beacon not running - $datetemp\n"; print OUTFILE " \n"; print OUTFILE "\n\n\n"; print OUTFILE "\n \n "; print OUTFILE "\n \n"; print OUTFILE " \n
\n"; print OUTFILE " "; print OUTFILE ""; print OUTFILE "Multicast Beacon"; print OUTFILE "\n"; print OUTFILE " v$VER-$SUBVER
\n"; print OUTFILE "
\n"; print OUTFILE "
\n"; # Write the links to the other files print OUTFILE "

\n\n"; if ($showmotd) { # Show the MOTD if flagged print OUTFILE "

\n\n$MOTD

"; } # Write the general information about this particular BeaconServer session print OUTFILE "Shutdown Time: $datetemp\n"; print OUTFILE "

\n\n"; print OUTFILE "

\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 "This Beacon, \"$tempbeacon\", is "; print OUTFILE "not currently running.
\n"; print OUTFILE "It was shut down or killed $datetemp.<\/b><\/font>\n"; print OUTFILE "

\n\n"; print OUTFILE "

\n\n"; print OUTFILE ""; print OUTFILE "Diagnosing problems with your multicast setup\n

\n\n"; print OUTFILE "

\n\n"; print OUTFILE "

\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 "Please note this list can only be posted to by \n"; print OUTFILE "SUBSCRIBERS, in order to keep it spam-free.\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 ""; print OUTFILE "http://archive.ncsa.uiuc.edu/lists/beacon.\n"; print OUTFILE "

\n"; print OUTFILE "

\n"; print OUTFILE "Another way to contact us is to use the \n"; print OUTFILE "DAST \n"; print OUTFILE "contact webform.\n"; print OUTFILE "\n\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