#!/usr/bin/perl
# -*-Fundamental-*-
# This is a Perforce review daemon. Originally by Richard Geiger
# Modified by Matthew Janulewicz to use perl's Mail::Sendmail module
#
# There are many review daemons in the world, and it's unlikely that
# any of them will be perfect for a given Perforce site without some
# customization. Indeed, the wonderous actions review daemons might
# take are limited only by your imagination.
#
# That said, here are some of the features of this one:
#
# - runs on Unix
# - written in perl;
# - can run in the background rather than being reinvoked by cron;
# - supports nifty "cc: in the description" or "cc: in the client spec"
# feature;
# - can log its activity if requested;
# - special every-change notifications to a separate cc list,
# with special subject line tags for such messages;
# - can add a hyperlink to p4web (or some other web-based Perforce browser)
# to display full change information
#
use Carp;
use strict;
use Mail::Sendmail;
$| = 1;
my $Myname;
($Myname = $0) =~ s%^.*/%%;
my $Myspac = $Myname;
$Myspac =~ s/./ /g;
my $Mydir = &dirname($0);
my $Here = `/bin/pwd`; chop $Here;
chdir $Mydir || die; $Mydir = `/bin/pwd`; chop $Mydir; chdir $Here || die;
my $Subject = "P4 Review Notification";
my (@pwent) = getpwuid($<);
if ($#pwent < 7)
{
print STDERR "$Myname: can't get your passwd file entry.\n";
exit 1;
}
my $Username = $pwent[0];
delete $ENV{"PWD"};
my $Usage = <<USAGE;
$Myname: usage:
$Myname [ verbose ] [ once ] [log <logfile>] [ p4port <p4port> ] [ p4config <p4config> ]
$Myspac [ interval <secs> ] [ notify <email> ] [ self ] [ from <sender> ]
$Myspac [ url <url_pat \%C> ] [ subject <sub_pat \%C> ] [ help ]
USAGE
sub usage
{
print STDERR "$Usage";
exit 1;
}
sub help
{
print STDERR <<LIT;
$Usage
$Myname is a p4 change review notification daemon.
Options:
verbose Be more verbose (for debugging, mainly)
once Run once then terminate (for use with cron)
log <logfile> Log actions to <logfile>
p4port <p4port> The Perforce server to do reviews for
p4config <p4config> Name to use for \$P4CONFIG
interval <secs> Seconds to sleep between reviews (0 means the same as "once") [60]
notify <email> Always send a separate notification to <email>
self Allow "Reviews" notifications to the user who submitted a change
from <sender> Set the From: header on notifications to <sender> [p4notifyd]
url <url_pat %C> Include a link to the change using <url_pat> (see below)
subject <sub_pat %C> Subject line for notification messages [Perforce change %C]
help Show this help message
Description:
This notify daemon can be used either by being run as a periodic
cron job (with the "once" option), or in a background mode (the
default), in which case it will sleep for a specified interval
(given with the "interval" option) between reviews.
It keeps track of it's highest-numbered reviewed change with
a counter named "p4notifyd".
Features:
This review daemon sends notifications addressed To: users, in the
customary manner: based on the Reviews: in their Perforce User
Specifications. Normally, the user submitting a change will _not_
be included in the To: list for a notification resulting from a
Reviews: match. (This can be overidden with the "self" option).
There are also some other ways to cause a user to be notified (and
these will be honored for the user submitting the change):
cc: in the submitting client specification:
When reviewing a change, the client specification for the client
from which the change was submitted is examined; if the
Description field contains a line of the format "cc: <address>[,]
<address>[,] ...", then the indicated addresses will be cc'ed on
the notification message for the change.
cc: in the change description:
Likewise, if the change description contains a line of the format
"cc: <address>[,] <address>[,] ...", then the indicated addresses
will be cc'ed on the notification message for the change.
The subject line to be used for notifications can be set with the
"subject <sub_pat %C>" option, by default "Perforce change %C".
Finally, the daemon can be configured to send notifications of ALL
changes unconditionally, with the "notify <email>" option. Such
messages have a recognizable Subject: line in the form
Subject: [ADMIN] <subject>
hyperlink to a web based view of the change description:
With the "url <url_pat>" option, "<url_pat> gives a pattern for a
URL that can be used to access the change description via a web
browser. The pattern should contain a %C, for which the change
number will be substituted in the actual notification message.
LIT
exit 1;
}
my $P4;
if (-x "/usr/bin/p4")
{ $P4 = "/usr/bin/p4"; }
else
{ die "can't find p4"; }
my $Notty = 1;
my $Log;
my $Notify;
my $P4port;
my $P4config;
my $Interval = 60; # Change review interval
my $Url_pat = "http://localhost:1666/\@md=d&cd=//&c=ms8\@/%C?ac=10";
my $Sub_pat = "Perforce change %C";
my $Noself = 1;
my $From = "p4_donotreply\@somecompany.com";
my $Counter = "p4notifyd"; # undocumented, for debugging
while ($#ARGV >= 0)
{
if ($ARGV[0] eq "verbose") { $Notty = 0; shift; next; }
elsif ($ARGV[0] eq "once") { $Interval = 0; shift; next; }
elsif ($ARGV[0] eq "self") { $Noself = 0; shift; next; }
elsif ($ARGV[0] eq "log")
{ shift; if ($#ARGV < 0) { &usage; } $Log = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "notify")
{ shift; if ($#ARGV < 0) { &usage; } $Notify = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "p4port")
{ shift; if ($#ARGV < 0) { &usage; } $P4port = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "p4config")
{ shift; if ($#ARGV < 0) { &usage; } $P4config = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "interval")
{ shift; if ($#ARGV < 0) { &usage; } $Interval = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "url")
{ shift; if ($#ARGV < 0) { &usage; } $Url_pat = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "from")
{ shift; if ($#ARGV < 0) { &usage; } $From = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "subject")
{ shift; if ($#ARGV < 0) { &usage; } $Sub_pat = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "counter") # undocumented, for debugging
{ shift; if ($#ARGV < 0) { &usage; } $Counter = $ARGV[0]; shift; next; }
elsif ($ARGV[0] eq "cc")
{ print "$Myname: compile check ok\n"; exit 0; }
else { &usage; }
}
if ($P4config) { $ENV{"P4CONFIG"} = $P4config; }
if ($P4port) { $P4 = "$P4 -p $P4port"; }
##### Normal daemon operation...
#
&msg("$Myname starting.\n", $Log, $Notty);
while (1)
{
&do_review;
if ($Interval == 0) { last; }
sleep $Interval;
}
sub do_review
{
my $topchange = 0;
&msg("do_review(): starting.\n", "", $Notty);
if (! open(REVIEW, "$P4 review -t $Counter |")) { return; }
Change: while(<REVIEW>)
{
# Format: "Change x user <email> (Full Name)"
#
my($change, $user, $email, $fullname) = /Change (\d*) (\S*) <(\S*)> (\(.*\))/;
&do_notify($change, $user, $email, $fullname);
$topchange = $change;
}
close REVIEW;
if ($topchange) { &s("$P4 review -c $topchange -t $Counter", 1, $Log, $Notty); }
}
sub do_notify
{
my($change, $user, $email, $fullname) = @_;
&msg("===== check change $change\n", $Log, $Notty);
# Get list of people who will be notified of this change
#
my $reviewers = "";
if (! open(REVIEWERS, "$P4 reviews -c $change |")) { next; }
while(<REVIEWERS>)
{
# user <email> (Full Name)
#
my($user2, $email2, $fullname2) = /(\S*) <(\S*)> (\(.*\))/;
# Use next line if author shouldn't get email, too.
#
if ($Noself && ($user eq $user2)) { next; }
if ($reviewers) { $reviewers .= ", "; }
$reviewers .= $email2;
}
close(REVIEWERS);
if (! open(DESCRIBE, "$P4 describe -s $change |")) { next; }
my $mailmsg = "";
my $state = "in_desc";
my @ccers;
my $clientname = "";
my $changenum;
while(<DESCRIBE>)
{
if (/^Change (\d+) by [^@\s]+@([^@\s]+) on \d\d\d\d\/\d\d\/\d\d \d\d:\d\d:\d\d/)
{ $changenum = $1; $clientname = $2; }
if (/^Jobs fixed .../ || /^Affected files .../) { $state = "pass"; }
if ($state eq "in_desc" && /^\t\s*cc:\s*(.*)$/i) # Add to the Cc list
{ push(@ccers, split(/[^a-z0-9_\-\.\@]+/i, $1)); }
$mailmsg .= $_;
}
close(DESCRIBE);
if ($changenum && $Url_pat)
{
my $url = $Url_pat;
$url =~ s/\%C/$change/g;
$mailmsg .= " $url\n";
}
my $subject = $Sub_pat;
$subject =~ s/\%C/$change/g;
if ($clientname)
{
if (! open(CLIENT, "$P4 client -o $clientname |")) { next; }
my $in_desc = 0;
cli_line: while(<CLIENT>)
{
if (/^Description:/)
{
while (<CLIENT>)
{
if (/^[^\s]/) { last cli_line; }
if (/^\t\s*cc:\s*(.*)$/i) # Add to the Cc list
{
my @cli_ccers;
@cli_ccers = split(/[^a-z0-9_\-\.\@]+/i, $1);
my $cli_ccers = join(", ", @cli_ccers);
push(@ccers, @cli_ccers);
}
}
}
}
close CLIENT;
}
# my $cmd = "$Sendmail -t";
# If anybody (like an administrator) wants special notifications of
# *all* changes, they can go here... (This allows the admin to
# still have a more meaningful list of notification subscriptions,
# and to quickly see which are which).
#
if ($Notify)
{
&msg("notify: $Notify\n", $Log, $Notty);
&mailme($Notify, $From, $Subject, $mailmsg);
}
my $ccers = join(", ", @ccers);
&nodups_reset;
$reviewers = &nodups_str($reviewers);
$ccers = &nodups_str($ccers);
if ($reviewers || $ccers)
{
if ($reviewers)
{
&msg("to: $reviewers\n", $Log, $Notty);
&mailme($reviewers, $From, $Subject, $mailmsg);
}
}
}
sub dirname
{
my ($dir) = @_;
$dir =~ s%^$%.%; $dir = "$dir/";
if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
{ $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
return ".";
}
sub msg
{
my($msg, $log, $notty, $mailto) = @_;
if ((! $notty) && -t STDERR) { print STDERR $msg; }
if (! $log) { return; }
if (! open(LOG, ">>$log"))
{
if (-t STDERR)
{ print STDERR "Can't open logfile \"$Log\": $! <$msg>\n"; }
}
else
{
$msg = sprintf("%14s %05s %-10s %s", &ts, $$, $Username, $msg);
print LOG $msg;
if ($mailto) { &mail($mailto, $msg); }
close LOG;
}
}
sub ts
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
return sprintf("%04d%02d%02d%02d%02d%02d", 1900+$year, $mon+1, $mday, $hour, $min, $sec);
}
sub s
{
my ($cmd, $exit_on_err, $log, $notty) = @_;
my ($sts, $output);
# May want to flip this on for debugging
#
if (0) { &msg("$Myname; $cmd\n", $log, $notty); return 0; }
&msg("$Myname> $cmd\n", $log, $notty);
if (! open(CMD, "$cmd 2>&1 |"))
{
&msg("$Myname: can't open \"$cmd 2>&1 |\": $!\n", $log, $notty);
if ($exit_on_err) { exit $sts; }
return 1;
}
while (<CMD>)
{
&msg(": $_", $log, $notty);
$output .= $_;
}
close CMD;
if ($sts = $?)
{
my $sig = $sts & 0x0f;
$sts = $sts >> 8;
&msg("$Myname: *** \"$cmd\" exited with signal $sig status $sts\n", $log, $notty);
if ($exit_on_err) { exit $sts; }
}
return ($sts, $output);
}
my %Seen;
sub nodups_reset
{
undef %Seen;
}
sub nodups_str
{
my ($l) = @_;
return (&nodups_list(split(/\s*,\s*/, $l)));
}
sub nodups_list
{
my (@l) = @_;
my @ln;
foreach my $i (@l)
{
if (! defined $Seen{$i}) { push(@ln, $i); }
$Seen{$i} = 1;
}
if ($#ln < 0) { return ""; }
return (join(", ", @ln));
}
# this uses the Perl module to mail the message instead of sendmail
sub mailme
{
my($to, $from, $subject, $msg) = @_;
my %mail_message = (smtp => 'necex1',
To => "$to",
From => "$from",
Subject => "$subject",
Message => "$msg"
);
sendmail(%mail_message) or die $Mail::Sendmail::error;
}