#!/usr/local/bin/perl
# Note: the above line is somewhat tied to the p4d unix
# init scripts - for searching and killing this process
#
# $Id: //guest/sandy_currier/utils/p4review.pl#1 $
#
#
# Copyright (c) 2000, Sandy Currier (sandy@releng.com)
# Distributed under the GNU GENERAL PUBLIC LICENSE:
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 1, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
#
# shamelessly taken from other people (but theirs was/is not copyrighted),
# but still here is the moral pointer to those who came before. Thank you.
#
#
# perfreview - A change review 'daemon' for Perforce changes.
# Sends email to user when files they've subscribed to
# change in the depot.
#
#
# Uses 'p4 review' to dish up changes for review,
# 'p4 reviews' to find out who should review the changes,
# 'p4 describe' to fill out mail to send to users, and
# '/usr/ucb/mail' to deliver the mail.
#
#
# 1) Make sure that $P4PORT is set to communicate with the
# p4d server.
#
# 2) Change the global variables as desired:
BEGIN: {
require 5.004;
unless ($Platform{'os'}) {
unless ($Platform{'os'} = $^O) {
require Config;
$Platform{'os'} = $Config::Config{'osname'};
$Platform{'os'} = $Config::Config{'osname'};
}
}
# bottom layer OS specific variables/constants
if ($Platform{'os'}=~/Win/i) {
#########################
# win32
#########################
$Platform{'os'} = "win32";
$Platform{'pd'} = '\\';
$Platform{'ps'} = "ps -ef";
} elsif ($Platform{'os'}=~/vms/i) {
#########################
# vms
#########################
die "vms is currently not a supported platform";
} elsif ($Platform{'os'}=~/os2/i) {
#########################
# os2
#########################
die "os2 is currently not a supported platform";
} elsif ($Platform{'os'}=~/Mac/i or (defined($MacPerl::Version) and $MacPerl::Version)) {
#########################
# mac
#########################
$Platform{'pd'} = ':'; # use this in pathname pattern matching (mac)
die "macintosh is currently not a supported platform";
} else {
#########################
# unix
#########################
$Platform{'os'} = "unix";
$Platform{'pd'} = '/';
$Platform{'ps'} = "ps -ef";
}
}
#
# set up some globals
# Note: assume that the PATH EV is going to be used to find p4
$ThisCmd = &BaseName(&other2unix($0)); # this command name
$vb = ">>>";
$err = "***";
$verbose = 0;
$Once = 0; # whether or not run and exit
$SendMail = "/usr/lib/sendmail"; # where to find the sendmail program
$SmbMail = "/usr/local/samba/bin/smbclient"; # where to find the smbclient
$ZephyrMail = "/usr/local/bin/zctl"; # where to find the zephyr client
$EmailDomain = "akamai.com"; # email domain (overrides the default)
$SleepTime = 60; # how long to sleep between wake-ups
$DeadManCount = 12; # the number of consecutive errors to get before exiting...
$PortNum = "";
$Host = "perforce.akamai.com"; # the default host for P4PORT
$P4PORT = ""; # the default P4PORT (must include -p switch)
$ENV{'P4CONFIG'} = ""; # default
$P4USER = "-u p4admin"; # the default P4USER (must include -u switch)
$P4 = "/usr/local/bin/p4";
$web_p = 0;
$WebTool = "http://dev/cgi-bin/PerfBrowse.perl";
$LogFile = ""; # the log file (nil means no log is written)
#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1; # Make STDERR be unbuffered.
select(STDOUT);
$| = 1; # STDOUT too so, they can mix.
#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd PORT LOGFILE
Function:
$ThisCmd can be run either in the background (or typically
once in the foreground) to implement a Perforce change review
daemon. $ThisCmd will simply email to those Perforce users
change desriptions of any change that effects a file that,
via the review field in the Perforce User form, a user has
selected to monitor.
The domain name of the recipient is ignored and overwritten
with $EmailDomain. However, if the domain name is
\"windows.<machinename>\", then a windows message will be sent.
If the domain name is \"zephyr\", a zephyr message is sent.
The script tests for other identical processes, and if another
one is running, will exit. The counter is incremented after
mail is sent. If the script blows up, email should not be
duplicated, and at most one change email should be lost.
Args:
PORT Optional arg to specify the PORT number.
Default host is $Host
LOGFILE If supplied, will write to it.
Switches/Options:
-h Prints this help message
";
#
# parse command line
{
my($i);
my($param) = 0;
while($i <= $#ARGV) {
# scan for a help switch
if ($ARGV[$i] =~ /^-h/i) {
&DieHelp("", $help);
}
# scan for variable definitions (-variable value)
elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) {
# NOTE: nt has a difficult time with '=' on a command line...
# process any variable value switches
my($var) = $ARGV[$i];
$var =~ s/^-//;
my($value) = $ARGV[$i+1];
if (defined $$var) {
$$var = $value;
}
else {
&DieHelp("Unknown parameter '$var'\n", $help);
}
$i=$i+2;
}
# catch unsupported switches
elsif ($ARGV[$i] =~ /^-/) {
&DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help);
}
elsif ($param == 0) {
# set the P4PORT
$PortNum = $ARGV[$i];
$i++; $param++;
}
elsif ($param == 1) {
# set the P4PORT
$LogFile = $ARGV[$i];
$i++; $param++;
}
else {
&DieHelp("Unsupported argument \"$ARGV[$i]\"\n", $help);
}
}
}
#
# deal with args
if ($PortNum) {
$P4PORT = "-p ${Host}:$PortNum";
}
# otherwise, just use defaults...
#
# start log
{
my($string) = &GetTime($^T);
unlink $LogFile if ($LogFile);
&WriteLog("$vb Starting $ThisCmd at $string\n");
}
#
# endless loop...
while (1) {
# first, see if this command is running; if so, punt completely
my(@output);
@output = &ExecuteP4Cmd("$Platform{'ps'}", $verbose);
if (grep(/$ThisCmd.*$PortNum/, @output) > 1) {
&PrintError("$ThisCmd: command already running. exiting");
last; # exit
}
# reset error and warning count. Do not update perforce counter if an
# error was received.
$Error{'Errors'} = $Error{'Warnings'} = 0;
#
# REVIEW - list of changes to review.
#
my(@reviews) = &ExecuteP4Cmd("$P4 $P4PORT $P4USER review -t review", $verbose);
chomp(@reviews);
# note: if the above errored, do a check and sleep
if ($Error{'Errors'}) {
&DeadManCheck();
undef @reviews;
}
foreach my $review (@reviews) {
#
# Format: "Change x user <email> (Full Name)"
#
my($change, $user, $email, $fullname, @sendmail, @smbmail, @smbmachines, @zephyrmail);
$review =~ /Change (\d*) (\S*) <(\S*)> (\(.*\))/;
$change = $1; $user = $2; $email = $3; $fullname = $4;
$email = &FixEmailAddr($email); # mmm...
&PrintMessage("review $change...") if ($verbose > 1);
#
# Get list of people who will review this change
#
my(@output) = &ExecuteP4Cmd("$P4 $P4PORT $P4USER reviews -c $change", $verbose);
chomp(@output);
# note: if the above errored, do a check and sleep
if ($Error{'Errors'}) {
&DeadManCheck();
last;
}
foreach (@output) {
# user <email> (Full Name)
my($user2, $email2, $fullname2) = /(\S*) <(\S*)> (\(.*\))/;
my($fixedemail2) = &FixEmailAddr($email2);
# mmm, the author is not interested in their own submits...
next if ($user eq $user2);
# hack: if the domain name of the user is windows, send via a smbclient
# if zephyr, send a zephyr message
# otherwise, send via unix (sendmail equivalent)
if ($email2 =~ /\@windows\.(.+)$/) {
push(@smbmachines, $1);
push(@smbmail, $fixedemail2);
}
elsif ($email2 =~ /\@zephyr$/) {
push(@zephyrmail, $fixedemail2);
}
else {
push(@sendmail, "$fixedemail2 $fullname2");
}
}
# send sendmail or window message or zephyr mail
if ($#sendmail >= 0) {
my($header, $message, @output, $rtn);
$header = "To: " . join(", ", @sendmail);
$header = "$header\nFrom: $email";
$header = "$header\nSubject: PERFORCE change review for change $change\n";
# add a ref to the perfbrowse page that describes this
# change
$header = "$header\n[see: $WebTool?\@describe+$change]\n" if ($web_p);
# now get description
@output = &ExecuteP4Cmd("$P4 $P4PORT $P4USER describe -s $change", $verbose);
foreach (@output) {
# don't allow single .'s through as that may close the mail reader...
# there should not be any anyway...
$_ = "\\." if (/^\.\s*$/);
$message = "$message$_";
}
$rtn = &SendSendmail($header, $message);
# ignore return value for now...
}
elsif ($#smbmail >= 0) {
my($header, $message, @output, $rtn);
$header = "To: " . join(", ", @smbmail);
$header = "$header\nFrom: $email";
$header = "$header\nSubject: PERFORCE change review for change $change\n";
# add a ref to the perfbrowse page that describes this
# change
$header = "$header\n[see: $WebTool?\@describe+$change]\n" if ($web_p);
# now get description
@output = &ExecuteP4Cmd("$P4 $P4PORT $P4USER describe -s $change", $verbose);
$message = join("", @output);
$rtn = &SendSmbMessage(\@smbmachines, "$header$message");
# ignore return value for now...
}
elsif ($#zephyrmail >= 0) {
# send a zephyr message
&PrintError("$ThisCmd: zephyrmail not supported yet");
}
#
# Update counter to reflect changes reviewed.
# But, do not do it if there has been error...
unless ($Error{'Errors'}) {
&ExecuteP4Cmd("$P4 $P4PORT $P4USER counter review $change", $verbose);
}
# note: if the above errored, do a check and sleep
if ($Error{'Errors'}) {
&DeadManCheck();
last;
}
}
# now either exit or sleep
if ($Once) {
last;
}
else {
sleep($SleepTime);
}
}
# the end
exit(0);
#
# subroutines
#
# dead man check
# gotta love those global variables...
sub DeadManCheck {
# even if the above errored...
if ($Error{'Errors'}) {
# there is an error for this run
$Error{'previous'}++;
if ($Error{'previous'} > $DeadManCount) {
&PrintError("$ThisCmd: exceeded dead man count ($DeadManCount). Exiting");
exit(1);
}
}
else {
$Error{'previous'}-- if ($Error{'previous'} > 0);
}
}
# will send email via sendmail
sub SendSendmail {
my($header, $message) = @_;
if (!open(SENDMAIL, "|$SendMail -t")) {
&PrintError("$ThisCmd: could not open $SendMail for sending;\n$!");
return(1);
}
elsif (!print SENDMAIL "$header$message") {
&PrintError("$ThisCmd: printing to $SendMail failed\n$!");
close SENDMAIL;
return(2);
}
elsif (!close SENDMAIL) {
&PrintError("$ThisCmd: could not close SENDMAIL\n$!");
return(3);
}
return(0);
}
# will send a window message via a smbclient
sub SendSmbMessage {
my($machines, $message) = @_;
my($errors);
foreach my $machine (@{$machines}) {
if (!open(SENDSMB, "|$SmbMail -M $machine > /dev/null")) {
&PrintNote("$ThisCmd: could not open $SmbMail for messaging;\n$!");
$errors++;
}
if (!print SENDSMB "$message") {
&PrintNote("$ThisCmd: printing to $SmbMail failed\n$!");
close SENDSMB;
$errors++;
}
elsif (!close SENDSMB) {
&PrintNote("$ThisCmd: could not close SENDSMB\n$!");
$errors++;
}
}
return($errors);
}
# will send a zypher message
sub SendViaZephyr {
my($header, $message) = @_;
if (!open(SENDZYPHER, "|$ZephyrMail -t")) {
&PrintError("$ThisCmd: could not open $ZephyrMail for sending;\n$!");
return(1);
}
elsif (!print SENDZYPHER "$header$message") {
&PrintError("$ThisCmd: printing to $ZephyrMail failed\n$!");
close SENDZYPHER;
return(2);
}
elsif (!close SENDZYPHER) {
&PrintError("$ThisCmd: could not close SENDZYPHER\n$!");
return(3);
}
return(0);
}
sub FixEmailAddr {
my($addr) = @_;
$addr =~ s/^(.*)@.*$/$1\@$EmailDomain/;
return($addr);
}
sub BaseName {
my($string) = @_;
$string =~ s|.*/([^/]*$)|$1|;
return("$string");
}
sub other2unix {
my($filename) = @_;
my($pattern) = $Platform{'pd'};
$pattern = quotemeta($pattern);
$filename =~ s|$pattern|/|g;
return($filename);
}
sub DieHelp {
my($str, $help) = @_;
print STDOUT "$err $str\nUsage: $help";
exit(2);
}
#
# Note: this will actually execute any command...
# returns the action of the revision of the specified file#revision
sub ExecuteP4Cmd {
my($script, $verbose, $print_output, $no_error_check, $stream_p) = @_;
my(@output);
if ($stream_p) {
print $stream_p "$vb\n$vb running: $script\n$vb\n" if ($verbose);
}
else {
print STDOUT "$vb\n$vb running: $script\n$vb\n" if ($verbose);
}
$ENV{'P4PASSWD'} = "" if ($script =~ /p4/);
if (!$Platform{'nt'} and $Platform{'os'} eq "win32") {
@output = `$script` unless ($printonly);
}
else {
@output = `$script 2>&1` unless ($printonly);
}
$ENV{'P4PASSWD'} = "";
if ($stream_p) {
print $stream_p "@output" if ($print_output);
} else {
print STDOUT "@output" if ($print_output);
}
if (!$no_error_check and $?) {
# now what - just keep going
&PrintError("$ThisCmd - something happened with '$script'\n$?", $stream_p);
}
return(@output);
}
sub PrintError {
my($text, $stream_p) = @_;
my($tmp) = &GetTime(time);
# first, increment error count
$Error{'Errors'}++;
# make sure $? is set
$? = 1;
# prepend with the correct prefix
$text =~ s/^(.*)$/$tmp $err $1/gm;
# add a \n
$text = "$text\n";
# print and log (maybe)
if ($verbose) {
if ($stream_p) {
print $stream_p "$text";
}
else {
print STDOUT "$text";
}
}
&WriteLog($text);
return(0);
}
# will increment $Error{'Warnings'} and append $err to every line
sub PrintWarning {
my($text, $stream_p) = @_;
my($tmp) = &GetTime(time);
# first, increment warning count
$Error{'Warnings'}++;
# prepend with the correct prefix
$text =~ s/^(.*)$/$tmp $err $1/gm;
# add a \n
$text = "$text\n";
# print and log (maybe)
if ($verbose) {
if ($stream_p) {
print $stream_p "$text";
}
else {
print STDOUT "$text";
}
}
&WriteLog($text);
return(0);
}
# will append $vb to every line
sub PrintMessage {
my($text, $stream_p) = @_;
my($tmp) = &GetTime(time);
# prepend with the correct prefix
$text =~ s/^(.*)$/$tmp $vb $1/gm;
# add a \n
$text = "$text\n";
# print and log (maybe)
if ($verbose) {
if ($stream_p) {
print $stream_p "$text";
}
else {
print STDOUT "$text";
}
}
&WriteLog($text);
return(0);
}
sub PrintNote {
my($text, $stream_p) = @_;
my($tmp) = &GetTime(time);
# prepend with the correct prefix
$text =~ s/^(.*)$/$tmp $err $1/gm;
# add a \n
$text = "$text\n";
# print and log (maybe)
if ($verbose) {
if ($stream_p) {
print $stream_p "$text";
}
else {
print STDOUT "$text";
}
}
&WriteLog($text);
return(0);
}
sub WriteLog {
my($message) = @_;
return(0) unless ($LogFile);
# just open and write
if (!open(LOG, ">>$LogFile")) {
# null log file
my($tmp) = $LogFile;
$LogFile = "";
&PrintError("$ThisCmd: could not open logfile '$tmp' for write\n$!");
exit(3);
}
# write it
print LOG $message;
close LOG;
return(0);
}
# will print time in a yyyymmdd.hhmmss format
sub GetTime {
my($time) = @_;
my(@ltime);
# Normally: ($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
@ltime = localtime($time);
# do not forget to add 1900 to the century, and 1 to the month
return(sprintf("%04d%02d%02d.%02d%02d%02d",
($ltime[5]+1900), $ltime[4]+1, $ltime[3],
$ltime[2], $ltime[1], $ltime[0]));
}