#!/usr/local/bin/perl
# -*-Fundamental-*-

#  Note: ***** This version supports Unix Perforce servers only!
#        ***** (And may need tweaking for your host OS: see under
#        ***** "CUSTOMIZING", below...
# 

use Carp;
use strict;
$| = 1;

my $Myname;
($Myname = $0) =~ s%^.*/%%;

my $Usage = <<LIT;
$Myname: usage:

  $Myname [ -p4d_i <regexp> ] [ -p4d_pid <pid> ] [-p4d_log <logpath> ] [ -tailn <tailsize> ]
          [ -p4d_iv <regexp> ]
LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage

$Myname combines information from a Perforce server host's process
list and the perforce server log file, and prints a list of current
perforce processes. Here's an example:

| rmg $ ./p4wd -p4d_log /u/p4/logs.p4netapp/p4d -p4d_pid 24099 -tailn 200000
|    97 2001/10/23 12:23:08   doucette doucette:raiders:50376 10.56.10.100 'user-flush \@135496'
|  5284 2001/10/23 11:16:09    ericcxu yadav:main 10.56.10.118 'user-diff prod/netcache/server/admin
|  6535 2001/10/23 12:18:47   rtpbuild rtpbuild:main:135505 10.60.132.58 'user-flush \@135501'
|  6881 2001/10/23 12:23:28   renglish daemon:main 10.56.10.43 'user-sync -n'
| 15211 15211  24099 p4d                  Mon Oct 22 16:16:23 2001 368K     0:00.01 /u/p
| 18120 2001/10/23 12:23:32      grier grier:test 10.97.1.25 'user-sync'
| 18385 2001/10/23 12:23:29   doucette doucette:raiders:56741 10.56.10.47 'user-flush //doucette:raiders:56741/.
| 20971 2001/10/23 12:23:31    kiyoshi kiyoshi:ontap:ncsr 172.29.19.40 'user-sync'
| 24099*24099      1 p4d                  Thu Oct 11 16:23:00 2001 272K    17:44.77 /u/p

      (^ indicates that this is the parent p4d process)

| 26385 2001/10/23 00:28:59    sunitha sunitha:parityflip_main 10.56.10.118 'user-submit'
| 26763 2001/10/23 12:19:55     jscott jscott:main:bug57014 10.60.132.16 'user-flush \@135485'

This requires that Perforce server logging has been enabled, with

  -L <logfile> -v server=1	(or server=2)

...which causes the server to log, for each client command, a message
of the form:

  Perforce server info:
          2001/10/23 12:00:36 pid 55459 super\@ct 10.0.0.197 'user-jobs -e callnumbers=103238'

Note that this includes the process id of the child p4d that was
forked to service the user operation, the Perforce user that requested
the operation, the originating client host name and IP, and some
information about operation was requested.

The options are:

  -p4d_i <regexp>	For servers that run p4d from inetd (i.e., where there
			is no resident parent p4d), the <regexp> gives a pattern
			that is matched against the output of "ps", to select
			the "p4d" processes associated with the depot to be monitored.

  -p4d_iv <regexp>	Like "-p4d_i", except that the <regexp> selects "ps" output lines
			to be explicitily _excluded_ from consideration.

  -p4d_pid		The process id of the master (parent) p4d process.

  -p4d_log <logpath>	Pathname to the p4d log file

  -tailn <tailsize>	The number of lines from the tail of the logfile to look at
			in order to build a list of recent p4d processes to be matched
			to the current "ps" output. Setting this larger will make the
			command take more time, but be better able to provide Perforce
			log information for p4d processes that have been in execution
			for a long time. (i.e., commands that were started earlier than
			the oldest Perforce log entries examined will show up as raw
			"ps" output). [1500]
 
You must supply the "-p4d_log" and either a "-p4d_i" or "-p4d_pid"
option.

LIT
  exit 1;
}

my %p4d;
my %log;

my $ps_head;

sub process_ent
{
  my ($line) = @_;
  my @l = split(/\s+/, $line);

  if ($l[4] =~ /:/) { return; }

  if (defined($p4d{$l[4]}))
    {
      if ($l[5] eq "completed")
        { delete ($log{$l[4]}); }
      else
        { $log{$l[4]} = $line; }
    }
}

# option switch variables get defaults here...

my $P4d_pid;
my $P4d_log;
my $Ntailn = "1500";
my $P4d_i;
my $P4d_iv;
my @Args;
my $Args;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-p4d_i")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_i = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-p4d_iv")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_iv = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-p4d_pid")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_pid = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-p4d_log")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_log = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-tailn")
      { shift; if ($ARGV[0] < 0) { &usage; } $Ntailn = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-help")
      { &help; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }

if ($#Args >= 0)
  {
    $Ntailn = shift @Args;
    $Ntailn =~ s/^-//; # backwards compatability
  }

#  We want, for each supported platform, a ps command that will, for
#  at _least_ the target p4d and all of it's children, produce output
#  where the first line is a header, and subseqent lines are process
#  info, with the first two columns being whitespace-split-able pid
#  and ppid.  This will yield output parseable by the generic parsing
#  code. For systems where this can't be achieved, you'll need to add
#  special-case parsing code for your system.
#
#  Feel free to customize for whatever ps output fields might be
#  useful, after the pid and ppid.
#
#  You'll also need to set "$Ntail" to be the right form for the
#  argument to tell your "tail" command how many lines to grab.
#

my $Ps_cmd;
my $Ntail;

my $uname = `uname -a`;
chomp $uname;
my (@U) = split(/\s+/, $uname);

if ($U[0] eq "OSF1")
  {
    $Ps_cmd = "/bin/ps -A -o pid -o ppid -o comm -o lstart -o rssize -o time -o args";
    $Ntail = "-$Ntailn";
  }
elsif ($U[0] eq "Linux" && $U[2] eq "2.4.2-2")
  {
    $Ps_cmd = "/bin/ps -eo pid,ppid,comm,lstart,rssize,time,args";
    $Ntail = "--lines=$Ntailn";
  }
elsif ($U[0] eq "FreeBSD" && $U[2] eq "4.1-RELEASE")
  {
    $Ps_cmd = "/bin/ps -axo pid,ppid,lstart,rsz,time,command";
    $Ntail = "-n $Ntailn";
  }
else
  { die "I don't know how to run on this <$uname>"; }

if (! $Ps_cmd) { die "Undetermined \$Ps_cmd"; }
if (! $Ntail)  { die "Undetermined \$Ntail"; }

if (-e "/u/p4/.p4d.p4netapp.pid")
#
#  (If we're at NetApp, for example...)
#
  {
    open(PID, "</u/p4/.p4d.p4netapp.pid") || die "open /u/p4/.p4d.p4netapp.pid";
    $P4d_pid = <PID>; chomp $P4d_pid;
  }

if (! $P4d_pid && ! $P4d_i) { die "Need to specify either -p4d_pid or -p4d_i"; }
if (! $P4d_log) { die "Need to specify -p4d_log"; }
if (! -r $P4d_log) { die "Can't read p4d_log <$P4d_log>"; }

open(PS, "$Ps_cmd |") || die "open $Ps_cmd";

while (<PS>)
  {
    chomp;
    if (/^\s*PID/i) { $ps_head = $_; }
    $_ =~ s/^\s*//;
    my ($pid, $ppid) = split(/\s+/, $_);

    # Weed out all processes except this server's p4d's:
    #
    if ($P4d_pid && (! ($pid eq $P4d_pid || $ppid eq $P4d_pid))) { next; }
    if ($P4d_i && $_ !~ /$P4d_i/) { next; }
    if ($P4d_iv && $_ =~ /$P4d_iv/) { next; }

    $p4d{$pid} = $_;
  }
close PS;

my $tail_cmd = "tail $Ntail $P4d_log";

open(TAIL, "$tail_cmd |") || die "open \$tail_cmd";

my $line = "";
while (<TAIL>)
  {
    chomp;

    if (/Perforce server (message|error|info):/)
      {
        if ($line) { &process_ent($line); }
        $line = ""; next; 
      }

    $_ =~ s/\s+/ /;
    $line .= "$_";
  }

if ($line) { &process_ent($line); }

#print "$ps_head\n";

foreach my $pid (sort {$a <=> $b} (keys(%p4d)))
  {
    if ($pid eq $P4d_pid || ! defined($log{$pid}))
      {
        printf "%5d%s%s\n", $pid, ($pid eq $P4d_pid ? "*" : " "), substr($p4d{$pid}, 0, 80);
        next;
      }

    $log{$pid} =~ s/^\s+//;  
    my @args;
    my $args;
    my ($day, $time, $PID, $P, $who, @args) = split(/\s+/, $log{$pid});
    $args = join(" ", @args);
    my $client;
    ($who, $client) = split(/@/, $who);
    $args = substr($args, 0, 50);
    printf "%5d %8s %8s %10s %s %s\n", $pid, $day, $time, $who, $client, $args;
  }