#!/usr/bin/perl
#
# $Header: //guest/robert_duff/p4scripts/monitor/p4monitor.pl#1 $
# $Date: 2003/06/17 $
# $Author: robert_duff $
# $Change: 3332 $
#
# Description: Used to continually monitor and match processes against the Perforce log file.
# Inspired by Richard Geiger's "p4wd" and David Clark's "p4conan.pl".

use strict;
use Socket;

# These variables cannot be modified on the command-line.  Modify them here if necessary.
my $secondserver="1668"; # If there is a secondary server, search for this in the ps output. 
my $pidsearchstring="p4d"; # Processes must have this search string to be considered for showing.

### Modifications below this line should not be necessary.  If they are, please let me know.

# These variables are for the command-line parameters.
my @logfile; # If we are going to read multiple log files, we will need an array.
$logfile[0]=$ENV{P4LOG};
my $p4user=$ENV{LOGNAME};
if(!$p4user)
{
	$p4user=$ENV{P4USER};
	if(!$p4user)
	{
		$p4user="perforce";
	}
}
my $remote_host;
my $remote_port;
my $kilobytes;
my $seconds;
my $dtdset;
my $xmlfile;

# These hashes are for the processes that are to be displayed.
my (%p4d, %log, %cpu, %mem, %time, %ppid);

my $progname;
($progname = $0) =~ s#^.*/##;

my $usage = <<USAGE;

Usage: $progname [ -h -xml xmlfile -p <server:>port -L logfile
       -u user -k kilobytes -delay seconds -dtd ]

This script combines the output of ps and the Perforce log file and prints the
information in XML format.  It can write to the screen or over the network via
TCP sockets.  The following info is listed: process ID, start time, CPU usage,
Perforce user, Perforce client, client IP address and the Perforce operation.

Parameters:
  -h, -?, help      Print this help message.
  -xml <filename>   Write XML data to a file instead of standard out.
  -p <server:port>  Name and port of the server. You can choose to only include
                    the port number and "server" will default to localhost.
                    This is NOT Perforce's name and port.  This is only for XML
                    traffic, to send the output to a listener process.
  -L <logfile>      Specify the location of the Perforce log file.  If none is 
                    specified, it will check for the \$P4LOG environ variable.
  -u <user>         Specify what UNIX user Perforce is running under.  If none
                    is specified, it will default to \$LOGNAME, and if it does
                    not exist, then to \$P4USER; if null, then to "perforce".
  -k <kilobytes>    Read back <n> kilobytes in the log file to start.  0 for
                    all of it, which is the default.
  -delay <seconds>  Specify the number of seconds to repeat.  0 for only once,
                    which is the default.  (Recommended using a delay to save
                    from tailing the log file uselessly every time.)
  -dtd              Print the Document Type Definition (DTD) before each output.


USAGE

&ReadParameters;
&DataPrep;

for(;;) # After initializing the variables and possibly connecting to the server, start the loop.
{
	my @pids_from_ps = &ReadProcesses; # Read in the Perforce processes
	my @pids_from_logs = &ReadLogs; # Read the logs for the Perforce processes running.

	# Remove old processes from the hashes to ensure we don't run out of memory eventually.
	foreach my $loginstance (@pids_from_logs) # For every process we have a hash for, do ...
	{
		my $check=0;
		foreach my $pidinstance (@pids_from_ps) # For every one of our running P4 processes, do ... 
		{
			if ($pidinstance == $loginstance) 
			{
				$check=1; # It appears that this hash is still valid, since the process is still running.
			}
		}
		if ($check == 0) # If the hash didn't have a matching process, delete it; we're done with it.
		{
			delete $p4d{$loginstance};
			delete $cpu{$loginstance};
			delete $mem{$loginstance};
			delete $time{$loginstance};
			delete $log{$loginstance};
			delete $ppid{$loginstance};
		} 
	}

	if($xmlfile) # If we're printing to a file, then do it now.
	{
		open(XMLFILE, ">$xmlfile") or die "Cannot write to XML output file $xmlfile: $!\n";
		select(XMLFILE); # We don't need to do this every time, but...  I'm lazy.
		&PrintXMLData(@pids_from_logs);
		close(XMLFILE);
	}
	else # Since we're not printing to a file, print the data out to whatever the selected output handle is.
	{
		&PrintXMLData(@pids_from_logs);
	}
	
	if($seconds > 0) # If $seconds is defined, wait for it.  Otherwise exit.
	{
		sleep($seconds);
	}
	else
	{
		exit 0;
	}
	my $logs=0;
	no strict;
	while(defined($logfile[$logs]))
	{
		seek($logs, 0, 1); # Since we're all done, see if there's anything new in the log for the next run.
		$logs++;
	}
	use strict;
}

# If requested, print the DTD for the XML data being output.
sub PrintDTD
{

my $dtd = <<DTD;
<!DOCTYPE p4snapshot [
  <!ELEMENT snapshot (title, column_headers, proc_data)>
    <!ELEMENT title (#PCDATA)>
    <!ELEMENT column_headers (col_start, col_mem, col_cpu, col_pid, col_user, col_client, col_op)>
      <!ELEMENT col_start (#PCDATA)>
      <!ELEMENT col_mem (#PCDATA)>
      <!ELEMENT col_cpu (#PCDATA)>
      <!ELEMENT col_pid (#PCDATA)>
      <!ELEMENT col_user (#PCDATA)>
      <!ELEMENT col_client (#PCDATA)>
      <!ELEMENT col_op (#PCDATA)>
    <!ELEMENT server_data (date, uptime)>
      <!ELEMENT date (#PCDATA)>
      <!ELEMENT uptime (up, users, load_fifteen, load_five, load_one)>
        <!ELEMENT up (#PCDATA)>
        <!ELEMENT load_fifteen (#PCDATA)>
        <!ELEMENT load_five (#PCDATA)>
        <!ELEMENT load_one (#PCDATA)>
      <!ELEMENT uname (os, machine_name, release)>
        <!ELEMENT os (#PCDATA)>
        <!ELEMENT machine_name (#PCDATA)>
        <!ELEMENT release (#PCDATA)>
      <!ELEMENT processes (process?)>
        <!ELEMENT process (proc_time, proc_mem, proc_cpu, proc_pid, proc_user?, proc_client?, proc_op?, proc_message?)*>
          <!ELEMENT proc_time (#PCDATA)>
          <!ELEMENT proc_mem (#PCDATA)>
          <!ELEMENT proc_cpu (#PCDATA)>
          <!ELEMENT proc_pid (#PCDATA)>
          <!ELEMENT proc_user (#PCDATA)>
          <!ELEMENT proc_clients (#PCDATA)>
          <!ELEMENT proc_op (CDATA)>
          <!ELEMENT proc_message (#PCDATA)>
          <!ELEMENT proc_ip (#PCDATA)>
          <!ELEMENT proc_parent (#PCDATA)>
]>

DTD

print $dtd;
}

# Read in the parameters from the command line.
sub ReadParameters
{
	my $logs = 0; # If $logs is equal to zero, there's 1 log.  This keeps track of how many logs are to be read.
	my $parameter = 0;
	while($parameter <= $#ARGV) # For as many parameters there are, run this loop.
	{
		if($ARGV[$parameter] eq "-h" or $ARGV[$parameter] eq "-?" or $ARGV[$parameter] eq "--help") # Print the usage information and exit.
		{
			print STDERR $usage;
			print "(current defaults: ";
			if($logfile[0]) { print "-L $logfile[0] "; }
			if($p4user) { print "-u $p4user"; }
			print ")\n\n";
			exit 1;
		}
		elsif($ARGV[$parameter] eq "-p") # Grab the server and port, and default to localhost if no host was found.
		{
			$parameter++;
			($remote_host, $remote_port) = split(/:/, $ARGV[$parameter]); # Split server:port up into two variables.
			if(!$remote_port) # If we were only given one argument, it should be the port.  So we adjust accordingly.
			{
				$remote_port=$remote_host;
				$remote_host="localhost";
			}
			elsif(!$remote_host)
			{
				$remote_host="localhost";
			}
		}
		elsif($ARGV[$parameter] eq "-L")
		{
			$parameter++;
			$logfile[$logs]=$ARGV[$parameter]; # Store the log locations in an array, since there may be more than one.
			$logs++;
		}
		elsif($ARGV[$parameter] eq "-u")
		{
			$parameter++;
			$p4user=$ARGV[$parameter];
		}
		elsif($ARGV[$parameter] eq "-delay")
		{
			$parameter++;
			$seconds=$ARGV[$parameter];
		}
		elsif($ARGV[$parameter] eq "-k") # Take the kilobytes, and convert them into negative bytes for "seek"
		{
			$parameter++;
			my $kilobytes_pos = $ARGV[$parameter] * 1024;
			$kilobytes = $kilobytes_pos - $kilobytes_pos - $kilobytes_pos;
		}
		elsif($ARGV[$parameter] eq "-xml")
		{
			$parameter++;
			$xmlfile=$ARGV[$parameter];
		}
		elsif($ARGV[$parameter] eq "-dtd")
		{
			$dtdset=1;
		}
		else
		{
			print STDERR "Error:  The parameter: $ARGV[$parameter] is not recognized.\n";
			print $usage;
			exit 1;
		}
		$parameter++; # On to the next parameter...
	}
}

# Test the parameters and prepare them for use.  Test for basic sanity as well.
sub DataPrep
{
	if($ENV{OS} eq "Windows_NT") # Since there's no way to truly fork on Windows systems, this script is useless on them.
	{
		die "Error: This script will not work on Windows-based systems.\n";
	}
	if($xmlfile && $remote_host) # If the user wants an XML file AND write to a network socket, fail.
	{
		die "Error: Output to a file and a network socket simultaneously is not yet implemented.\n";
	}
	if($xmlfile) # If the user wants an XML file, make sure we can write to it.
	{
		open(XMLFILE, ">$xmlfile") or die "Cannot write to XML output file $xmlfile: $!\n";
		close(XMLFILE);
		print STDOUT "Data will be written to: $xmlfile\n";
	}
	my $logs=0;
	no strict; # This is needed for the "open" line below, because I'm using a reference for a file handle.
	while(defined($logfile[$logs])) # Open all the logs we are required to monitor.
	{
		open($logs, "<$logfile[$logs]") or die "The P4 log file could not be opened: $logfile[$logs]\n";
		$logs++;
	}
	use strict;
	if($remote_host) # If remote_host isn't defined, (-p wasn't used) then don't bother trying to connect to a non-existent server.
	{
		socket(Server, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
		my $internet_addr = inet_aton($remote_host) or warn "Couldn't convert $remote_host into an Internet address: $!\n";
		my $paddr = sockaddr_in($remote_port, $internet_addr);
		if(connect(Server, $paddr))
		{
			select(Server); # We will want to use this connection to send our standard output.
			select((select(Server), $| = 1)[0]); # Enable command buffering.
			print STDOUT "Listener (remote) found at $remote_host:$remote_port.  Output redirected to that location.\n";
		}
		else
		{
			print STDOUT "Listener (remote) was NOT found at $remote_host:$remote_port.  Redirection failed.\n";
		}
	}
	if ($kilobytes < 0) # If the user doesn't want to read the entire file, then read back to $kilobytes.
	{
		my $logs=0;
		no strict;
		while(defined($logfile[$logs]))
		{
			seek($logs, $kilobytes, 2);
			$logs++;
		}
		use strict;
	}
}

# Print out the process information for processes that we don't have much info on.
sub PrintAnonProcess
{
	my $pid=$_[1];
	print "      <process pid=\"$pid\">\n        <proc_time>$time{$pid}</proc_time>\n";
	print "        <proc_mem>$mem{$pid}</proc_mem>\n        <proc_cpu>$cpu{$pid}</proc_cpu>\n";
	print "        <proc_pid>$pid</proc_pid>\n        <proc_message>(".$_[0]." process)</proc_message>\n";
	print "        <proc_parent>$ppid{$pid}</proc_parent>\n";
	print "      </process>\n";
}

# Read the processes currently running, filter them and then spit out the Perforce ones.
sub ReadProcesses
{
	my @pids;
	open(PS, "ps -o pid -o ppid -o comm -o pcpu -o vsz -o stime -o args -u $p4user|") or die "Failed while trying to get the list of processes.";
	while (<PS>) # While there are processes reported by "ps", do ...
	{
		chomp;
		$_ =~ s/^\s*//; # Remove spaces in front of the lines of the ps output.
		my ($pid, $ppid, $cmd, @args) = split(/\s+/, $_); # Assign the pertinent data of the processes to hashes
		$cpu{$pid} = shift(@args);
		$mem{$pid} = shift(@args);
		$time{$pid} = shift(@args);
		$ppid{$pid} = $ppid;
		if ($cmd !~ /$pidsearchstring/) # If the process doesn't have "p4d" in it, skip it.
		{
			next;
		}
		$p4d{$pid} = join(" ", @args);
		push(@pids,$pid); # Add this process to our current list of running processes.
	}
	close PS;
	@pids = sort {$a <=> $b} (@pids); # Sort all of our running P4 processes.
	return @pids;
}

# Read the logs since the last read, and filter out the garbage and spit out the log entries we have for the processes.
sub ReadLogs
{
	my $logs=0;
	while(defined($logfile[$logs]))
	{
		no strict;
		while ($_ = <$logs>) # While there is a log line left in the section we've just read, do ...
		{
			my $logline = $_;
			next if (/completed/o); # Skip lines that mean nothing to us.
			next if (/Perforce server/o);
			next if (/compute/o);
			if ($logline) # If a line exists (i.e. not blank).
			{
				my @line_contents = split(/\s+/, $logline); # Split the log line up into usable pieces.
				if (defined($p4d{$line_contents[4]})) # If there's something where a PID should be, let's hope it's a PID.
				{
					$log{$line_contents[4]} = $logline; # Create an entry in the %log hash, with the PID as the key and the log line as the value.
				}
			}
			next; # Move on to the next line.
		}
		use strict;
		my @pids = sort {$a <=> $b} (keys(%p4d)); # Sort all of our processes that we have hashes for.
		return @pids;
	}
}

# Print out the entire XML data.  Also throw in a few stats about the machine.
# I know what you're thinking...  Could have used one of the many XML modules in Perl!  Well, I was new to Perl when I wrote this.
sub PrintXMLData
{
	my @pids = @_;
	print "<?xml version=\"1.0\" ?>\n"; # Print out the XML version identifier.
	if($dtdset) # Print out the hardcoded DTD if requested to do so.
	{
		&PrintDTD;
	}
	chomp(my $xml_date=`date`);
	chomp(my $xml_uptime=`uptime`);
	chomp(my $xml_uname=`uname -a`);
	if ($xml_uptime =~ /day/) # If the machine hasn't been up for a day, then kludge it into looking nice.
	{
		$xml_uptime =~ s/.*up\s+(\d+).*load average:(.*)/$1 days, $2/;
	}
	else
	{
		$xml_uptime =~ s/.*load average:(.*)/0 days, $1/;
	}
	my ($xml_up, $xml_load_one, $xml_load_five, $xml_load_fifteen) = split(/,/, $xml_uptime);
	my ($xml_os, $xml_machine_name, $xml_release) = split(/ /, $xml_uname);
	print "<snapshot>\n  <title> Perforce Load Snapshot </title>\n  <column_headers>\n";
	print "    <col_start> Start </col_start>\n    <col_mem> Memory </col_mem>\n";
	print "    <col_cpu> CPU </col_cpu>\n    <col_pid> PID </col_pid>\n";
	print "    <col_user> User </col_user>\n    <col_client> Client </col_client>\n";
	print "    <col_op> Operations </col_op>\n";
	print "  </column_headers>\n  <server_data>\n    <date> ".$xml_date." </date>\n";
	print "    <uptime>\n      <up>$xml_up</up>\n      <load_fifteen>$xml_load_fifteen</load_fifteen>\n";
	print "      <load_five>$xml_load_five</load_five>\n      <load_one>$xml_load_one</load_one>\n";
	print "    </uptime>\n    <uname>\n      <os>$xml_os</os>\n      <machine_name>$xml_machine_name</machine_name>\n";
	print "      <release>$xml_release</release>\n    </uname>\n    <processes>\n";
	foreach my $pid (@pids)
	{
		if (! defined($log{$pid})) # If we've screwed up and can't identify a process by using the log, show what we can.
		{
			if ($p4d{$pid} =~ /$secondserver/) # On our server, we have other p4 processes for backup purposes.  Show them like this.
			{
				&PrintAnonProcess("secondary server",$pid);
				next;
			}
			elsif ($ppid{$pid} == 1) # We have a special output line for the master listener process.
			{
				&PrintAnonProcess("primary server",$pid);
				next;
			}
			elsif (defined($time{$pid})) # If %time is defined, show a line, with (unknown process) as the Perforce data.
			{
				&PrintAnonProcess("unknown",$pid);
				next;
			}
			next; # Since %time wasn't defined, %mem and %cpu likely aren't defined either.  Toss it; all we have is a PID anyway.
		}
		$log{$pid} =~ s/^\s+//; # Get rid of the leading spaces on the line.
		my ($day, $time, $garbage, $P, $who, @args) = split(/\s+/, $log{$pid}); # Split the log line up into usable pieces.
		my $args = join(" ", @args); # Rejoin all the extra arguments at the end of the line into one.
		$args =~ /^(.*)\s'(.*)'/; # Separate the IP address from the actual action.
		my $ip = $1;
		my $action = $2;
		my $client;
		($who, $client) = split(/@/, $who); # Take the user name and the client, and split them up into separate variables.
		$action = substr($action, 0, 70);
		$client = substr($client, 0, 30);
		$args = substr($args, 0, 50);
		if ($who eq "server")
		{
			&PrintAnonProcess("primary server",$pid);
		}
		else # Finally -- now we get to processes where there are log entries!
		{
			print "      <process pid=\"$pid\">\n        <proc_time>$time{$pid}</proc_time>\n";
			print "        <proc_mem>$mem{$pid}</proc_mem>\n        <proc_cpu>$cpu{$pid}</proc_cpu>\n";
			print "        <proc_pid>$pid</proc_pid>\n        <proc_user>$who</proc_user>\n";
			print "        <proc_client>$client</proc_client>\n        <proc_op>$action</proc_op>\n";
			print "        <proc_ip>$ip</proc_ip>\n";
			print "        <proc_parent>$ppid{$pid}</proc_parent>\n";
			print "      </process>\n";
		}
	}
	print "    </processes>\n  </server_data>\n</snapshot>\n\n";
}