#!/usr/local/bin/perl -w
#
# p4d-watch-admin.pl
#
# Warning: 
#    Anyone with access to this file has complete, 
#    automatic control of your Perforce installation.
#
# Warning: 
#    Anyone with access to this file can automatically 
#    modify any file on the network.  See p4d-watch.html
#
# THIS CODE IS PROVIDED AS-IS WITHOUT WARRANTY OR COPYRIGHT.
#
# $Id: //guest/brad_barber/p4d-watch/main/p4d-watch-admin.pl#2 $
# $Date: 2002/07/09 $$Change: 1939 $$Author: brad_barber $

use Getopt::Long;
use diagnostics;
use strict;
use IPC::Open2;

use Time::localtime;

#######################
### Usage and help
#######################

$::usage = "
Usage: p4d-watch-admin.pl [--log file] [--sync host] [--follow] [--help --version --debug]
";

$::help = "
$::usage
Issue 'p4 sync arg' command on a \@sync-name\@ event

Example: p4d-watch-admin.pl --follow

Options:

Input:
  \@ev\@ 0 \@sync-se\@ \@//se/web/main/...\@ \@2002/05/22 20:31:26\@ 241019 \@lbilbao\@ \@MR-OZIMANDIAS\@

Options:
  --change n	    start watching at \@n
  --eventlog s	    event log [default 'p4d-watch.log']
		      \@ev\@ rev \@event\@ \@args\@ \@date\@ change \@user\@ \@client\@
  --follow	    continue to watch for new entries
  --log file	    write event log to file [p4d-watch-admin.log]
  --sync $host      ignore events except for 'p4-sync $host'
  --sync p4d	    ignore events except for 'p4d...'

Help options:
  --debug	    print debugging messages to stdout
  --help	    print this message and exit
  --version	    print version number and exit

Events:
  p4d-group //file	    set p4 group with default maxresults maxscanrows
  p4d-protect //file	    set p4 protect, add in each user
  p4d-print //file file2	    p4 print -q depotfile >file
  p4-sync 
";

#######################
### Globals
#######################

$::version = '$Date: 2002/07/09 $$Author: brad_barber $$Id: //guest/brad_barber/p4d-watch/main/p4d-watch-admin.pl#2 $';
   
		    # default options
$::change_first = 0;
$::debug = 0;		
$::maxResults = 50000;
$::maxScanRows = 300000;
$::eventlog = "p4d-watch.log";
$::log = "p4d-watch-admin.log";
$::follow = 0;
$::sync = "";


		    # hashes and arrays


#######################
### Main 
#######################

&SlurpCommandLine();

open(EVENTLOG, $::eventlog) or die("can not open file $::eventlog: $!");
if ($::follow && $::change_first == 0) {
    seek(EVENTLOG, 0, 2);  # seek to EOF
}
open(LOG, ">> $::log")
    or die "Could not open log file $::log: $!\n";
{   # set OUTPUT_AUTOFLUSH
    my $old_fh = select(LOG);
    $| = 1;
    select($old_fh);
}

my $isfollow = 1;
while ($isfollow) {
    # $select->canread() is apparently always true on files
    while (<EVENTLOG>) {
	my ($event, $argA, $argB, $argC, $date, $change, $user, $client, $p4action);

	if (/^\@ev\@ [0-9]+ \@([^@]*)\@ \@([^@]*)\@\@([^@]*)\@\@([^@]*)\@ \@([^@]*)\@ ([0-9]+) \@([^@]*)\@ \@([^@]*)\@ \@([^@]*)\@/) {
	    $event = $1;
	    $argA = $2;
	    $argB = $3;
	    $argC = $4;
	    $date = $5;
	    $change = $6;
	    $user = $7;
	    $client = $8;
	    $p4action = $9;
	} elsif (/^\@ev\@ [0-9]+ \@([^@]*)\@ \@([^@]*)\@\@([^@]*)\@ \@([^@]*)\@ ([0-9]+) \@([^@]*)\@ \@([^@]*)\@ \@([^@]*)\@/) {
	    $event = $1;
	    $argA = $2;
	    $argB = $3;
	    $argC = "";
	    $date = $4;
	    $change = $5;
	    $user = $6;
	    $client = $7;
	    $p4action = $8;
	} elsif (/^\@ev\@ [0-9]+ \@([^@]*)\@ \@([^@]*)\@ \@([^@]*)\@ ([0-9]+) \@([^@]*)\@ \@([^@]*)\@ \@([^@]*)\@/) {
	    $event = $1;
	    $argA = $2;
	    $argB = "";
	    $argC = "";
	    $date = $3;
	    $change = $4;
	    $user = $5;
	    $client = $6;
	    $p4action = $7;
	}
	# untaint the input arguments
	next if (!defined $event);
	next if ($change < $::change_first);
	if ($event =~ /([^-\w]+)/ 
	|| $argA =~ /([^- \w.=+\/,]+)/
	|| $argB =~ /([^- \w.=+\/,]+)/
	|| $argC =~ /([^- \w.=+\/,]+)/) {
	    print LOG &Today()." \@$change Error: illegal character '$1' in event '$event' argA '$argA' argB '$argB' argC '$argC'\n";
	    next;
	}
	next if (substr($event, 0, 2) ne "p4");
	print &Today() . " \@$change $event argA $argA argB $argB argC $argC\n" if $::debug;
	if (substr($event, 0, 3) eq "p4d") {
    	    if ($::sync eq "" || $::sync eq "p4d" ) {
		if ($event eq "p4d-group") {
		    &Process_p4group($change, $argA, $p4action);
		} elsif ($event eq "p4d-newwatch") {
		    next;  # see p4d-watch.pl#Process_newwatch()
		} elsif ($event eq "p4d-print") {
		    &Process_p4print($change, $argA, $argB);
		} elsif ($event eq "p4d-protect") {
		    &Process_p4protect($change, $argA);
		} else {
    		    print &Today() . " \@$change Error: unknown event $event argA $argA argB $argB argC $argC\n" if $::debug;
		}
	    }
	} else {
    	    if ($::sync eq "" || $::sync eq $argA ) {
		if ($event eq "p4-sync") {
		    &Process_p4sync($change, $argA, $argB, $argC);
		} else {
    		    print &Today() . " \@$change Error: unknown event $event argA $argA argB $argB argC $argC\n" if $::debug;
		}
	    }
	}
    }
    seek(EVENTLOG, 0, 1);  # clear EOF flag
    sleep(1);
    $isfollow = $::follow;
}
exit 0;


#+--------
# Process_p4group -- update a group
#
sub Process_p4group () {
    my ($change, $depotfile, $p4action) = (@_); 
    my $group;
    my $groupfile;

    print LOG &Today() . " \@$change Process_p4group: $p4action $depotfile  ";
    if ($p4action eq "delete") {
	if ($depotfile =~ /group\/(.*)\.txt/) {
	    $groupfile = $1;
	} else {
	    print LOG "Error: can not delete group $depotfile: unknown format\n";
	    return;
	}
        my $results = `p4 group -d $groupfile 2>&1`;
        print LOG $results;
    } else {
	my $text = `p4 print -q "$depotfile" 2>&1`;
	if ($text =~ /\nGroup:\s+([-\w]+)/) {
	    $group = $1;
	    if ($depotfile =~ /(group\/$group.*\.txt)/) {
		$groupfile = $1;
	    } else {
		print LOG "Error: group $1, is not a prefix of $depotfile\n";
		return;
	    }
	} else {
	    print LOG "Error: missing 'Group:'\n";
	    return;
	}
	$text =~ s/\s*#.*//g;	    # remove comments
	$text =~ s/\n\s*$//gm;	    # remove blank lines
	$text =~ s/Users:\s*$//;    # remove trailing Users line
	$text =~ s/\n.*\.txt.*//g;  # remove .txt lines
	# add $groupfile and default values
	if ($text !~ /\nSubgroups:.*/) {
	    $text .= "\nSubgroups:\n";
	}
	$text =~ s/\nSubgroups:/\nSubgroups:\n    $depotfile/;
	if ($text !~ /\nMaxResults:\s+[0-9]+/) {
	    $text =~ s/\nMaxResults:.*//;
	    $text .= "\nMaxResults: $::maxResults\n";
	}
	if ($text !~ /\nMaxScanRows:\s+[0-9]+/) {
	    $text =~ s/\nMaxScanRows:.*//;
	    $text .= "\nMaxScanRows: $::maxScanRows\n";
	}
	if ($::debug) {
	    print "Process_p4group: $depotfile\nText:\n$text";
	}
	open2(*RESULTS, *INPUT, "p4 group -i 2>&1");
	print INPUT $text;
	close(INPUT);
	my $results = <RESULTS>;
	close(RESULTS);
	print LOG $results;
    }
}

#+--------
# Process_p4print -- update a print
#
sub Process_p4print () {
    my ($change, $depotfile, $destination) = (@_); 

    print LOG &Today() . " \@$change Process_p4print: arg1 $depotfile arg2 $destination\n";
    if (!defined $destination) {
	print LOG "Error: Missing destination file\n";
	return;
    }
    my $text = `p4 print -q "$depotfile" 2>&1 1>$destination`;
    if ($text !~ /^$/) {
	print LOG "Error: Could not print '$depotfile' to '$destination':\n $text";
	return;
    }
}

#+--------
# Process_p4protect -- update a protect
#
sub Process_p4protect () {
    my ($change, $depotfile) = (@_); 
    my $waserror = 0;

    print LOG &Today() . " \@$change Process_p4protect $depotfile ";
    my $text = "\n" . `p4 print -q "$depotfile" 2>&1`;
    if ($text !~ /write user/) {
	print LOG "Error: Could not 'p4 print $depotfile':\n";
	$waserror = 1;
    }
    $text =~ s/\s*#.*//g;	# remove comments
    $text =~ s/\n\s*$//gm;	# remove blank lines
    $text =~ s/\n/\n   /g;	# indent all lines
    my $users = "\n" . `p4 users 2>&1 | grep -v read-only`;
    if ($users !~ / accessed /) {
	print LOG "Error: Did not read 'p4 users':$users";
	return;
    }
    $users =~ s|\n([-\w]+) .*|\n    write user $1 * //user/$1/...|g;
    if ($users =~ /\n([^ ].*)/) {
	print LOG "Error: Unknown user 'character': $1\n";
	$waserror = 1;
    }	
    return if $waserror;
    if ($::debug) {
	print "Protections:\n";
	print $text;
	print $users;
	return;
    }
    open2(*RESULTS, *INPUT, "p4 protect -i 2>&1");
    print INPUT "Protections:\n";
    print INPUT $text;
    print INPUT $users;
    close(INPUT);
    my $results = <RESULTS>;
    close(RESULTS);
    print LOG $results;
}

#+--------
# Process_p4sync -- Perform a remote sync
#
sub Process_p4sync () {
    my ($change, $host, $client, $filespec) = (@_); 

    my $ssh_command = "ssh -n $host p4 -c $client sync $filespec 2>&1";
    if ($::debug) {
	print "Process_p4sync: \@$change $ssh_command\n";
    }
    if (!defined $filespec) {
	print LOG &Today() . "Process_p4sync: \@$change Error: missing filespec, e.g., nibbler\@road-nibbler-roadweb\@$filespec\n";
	return;
    }
    if ($host =~ /\s/ || $client =~ /\s/) {
	print LOG &Today() . "Process_p4sync: \@$change Error: do not include spacing in host '$host' or client '$client', e.g., nibbler\@road-nibbler-roadweb\@$filespec\n";
	return;
    }
    my $results = `$ssh_command`;
    print LOG &Today() . " \@$change Process_p4sync: $results";
}

#+--------
# SlurpCommandLine() reads in the command line, sets global variables according
# to the command line parameters, and populates the global @::users array.
sub SlurpCommandLine() {
    my %options = ();
    my ($tlogfile,$tinput,$tusername,$tfullname,$tgroup,$tpasswd);
    my ($input,$username,$fullname,$group,$passwd);

    # read all of the options
    GetOptions(\%options,
	       "log=s",
	       "sync=s",
	       "eventlog=s",
	       "change=n",
	       "follow!",
	       "help",
	       "version",
	       "debug!",
		) or die $::usage;

    if (defined($options{'help'})) {
	    print "$::help";
	    exit 0;
    }
    if (defined($options{'version'})) {
        print $::version, "\n";
        exit 0;
    }
    if (defined($options{'debug'})) {
        $::debug = 1;
    }
    if (defined($options{'change'})) {
        $::change_first = $options{'change'};
    }
    if (defined($options{'eventlog'})) {
        my $teventlog = $options{'eventlog'};
        # Untaint the eventlog
        $teventlog =~ /^([-\w.=+\/,0-9]*)$/;
        $::eventlog = $1;
    }
    if (defined($options{'follow'})) {
        $::follow = $options{'follow'};
    }
    if (defined($options{'log'})) {
        my $tlog = $options{'log'};
        # Untaint the log
        $tlog =~ /^([-\w.=+\/,0-9]*)$/;
        $::log = $1;
    }
    if (defined($options{'sync'})) {
	$::sync = $options{'sync'};
    }
}

#+--------
# Today() returns today's date as yyyy/mm/dd hh:mm:ss
sub Today() {
    my $tm = localtime;
    my $date = sprintf "%04d/%02d/%02d %02d:%02d:%02d",
	$tm->year+1900, $tm->mon+1, $tm->mday, $tm->hour, $tm->min, $tm->sec;
    return $date;
}