p4notifyd #24

eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH
#
# -*-Fundamental-*-

# $Id: //guest/richard_geiger/utils/p4notifyd#24 $

#  TBD:
#   - add restart control
#

#  This is a Perforce review daemon. Originally by Richard Geiger
#
#  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
#
#    New and Improved: support for Data Domain's change review regimen.
#

use Carp;
use strict;

$| = 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 (@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>] [ p4config <p4config> ]
  $Myspac [ p4port <port> ] [ p4user <user> ] [ p4passwd <password> ]
  $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
  p4user <p4user>      The perforce user to use
  p4passwd <password>  The password to use 	      
  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/local/bin/p4")
  { $P4 = "/usr/local/bin/p4"; }
elsif (-x "/a/tools/bin/p4")
  { $P4 = "/a/tools/bin/p4"; }
elsif (-x "/usr/bin/p4")
  { $P4 = "/usr/bin/p4"; }
else
  { die "can't find p4"; }


my $Notty = 1;

my $Log;
my $Notify;
my $P4port;
my $P4user;
my $P4passwd;
my $P4config;
my $Interval = 60;         # Change review interval
my $Url_pat;
my $Sub_pat = "Perforce change %C";
my $Noself = 1;
my $From = "p4notifyd";
my $Counter = "p4notifyd"; # undocumented, for debugging

my $Sendmail;		   
if (-x "/usr/lib/sendmail")
  { $Sendmail = "/usr/lib/sendmail"; }
elsif (-x "/usr/sbin/sendmail")
  { $Sendmail = "/usr/sbin/sendmail"; }
else
  { die "can't find sendmail"; }

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 "p4user")
      { shift; if ($#ARGV < 0) { &usage; } $P4user = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "p4passwd")
      { shift; if ($#ARGV < 0) { &usage; } $P4passwd = $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 "sendmail") # undocumented, for debugging
      { shift; if ($#ARGV < 0) { &usage; } $Sendmail = $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"; }
if ($P4user)   { $P4 = "$P4 -u $P4user"; }
if ($P4passwd) { $P4 = "$P4 -P $P4passwd"; }

##### 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 @revby;
  my @revrq;
  my $changenum; 
  my $author;
  my $clientname = "";
#  my $emergent = 0;
  while(<DESCRIBE>)
    {
      chomp;
      if (/^Change (\d+) by ([^@\s]+)@([^@\s]+) on \d\d\d\d\/\d\d\/\d\d \d\d:\d\d:\d\d/)
        { $changenum = $1; $author = $2; $clientname = $3; }

      if (/^Jobs fixed .../ || /^Affected files .../) { $state = "pass"; }

      if ($state eq "in_desc" && /^\t\s*cc:\s*([^\s#]*)$/i) #  Add to the Cc list
        { push(@ccers, split(/[^a-z0-9_\-\.\@]+/i, $1)); }

#      if ($state eq "in_desc" && /^\t\s*review(ed-by|er):\s*([^#]*)$/i)
#        {
#          foreach my $u (split(/[ ,]+/, $2))
#           {
#	     if ($u =~ /emergency/i)
#               { $emergent = 1; }
#             else
#               { push (@revby, $u); }
#           }
#        }

#      if ($state eq "in_desc" && /^\t\s*review-req:\s*([^\s#]*)$/i)
#        { foreach my $u (split(/[ ,]+/, $1)) { push (@revrq, $u); } }

      $mailmsg .= "$_\n";
    }
  close(DESCRIBE);

  my $url;
  if ($changenum && $Url_pat)
    {
      $url = $Url_pat;
      $url =~ s/\%C/$change/g;
      $mailmsg .= "  $url\n";
    }

  my $subject = $Sub_pat;
  $subject =~ s/\%C/$change/g;

#  if ($emergent)
#    {
#      $subject .= " *** EMERGENCY UNREVIEWED CHANGE! ***";
#      if ($reviewers) { $reviewers .= ", "; }
#      $reviewers .= "engineering\@datadomain.com";
#    }
    
  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);

      if (open(MAIL, "| $cmd" ))
        {
          print MAIL <<MSG;
To: $Notify
From: $From
Reply-To: $email ($fullname)
Subject: [ADMIN] $subject

MSG
          print MAIL $mailmsg;
          close(MAIL);
        }
    }

  my $ccers = join(", ", @ccers);

  &nodups_reset;

  $reviewers = &nodups_str($reviewers);
  $ccers = &nodups_str($ccers);

#my $orig_reviewers = $reviewers;
#$reviewers = "richard\@kosmix.com";
#$ccers = "";

  if ($reviewers || $ccers)
    {
      if (! open(MAIL, "| $cmd")) { next; } 

      if ($reviewers)
        {
          &msg("notify-to: $reviewers\n", $Log, $Notty);
          print MAIL <<MSG;
To: $reviewers
MSG
        }
      if ($ccers)
        {
          &msg("notify-cc: $ccers\n", $Log, $Notty);
          print MAIL <<MSG;
Cc: $ccers
MSG
        }

      print MAIL <<MSG;
From: $From
Reply-To: $email ($fullname)
Subject: $subject

MSG
      print MAIL $mailmsg;
      close(MAIL);
    }

#  if ($#revby >= 0)
#    {
#      if (! open(MAIL, "| $cmd")) { next; } 
#      my $to = join(", ", @revby);
#      my $msg = <<MSG;
#To: $to
#cc: $author
#From: $From
#Reply-To: $email ($fullname)
#Subject: Thanks for reviewing change $changenum by $author
#
#Newly submitted change list $changenum lists you as a reviewer.  If
#this is correct (i.e., you have already completed a review of this
#change): Thanks! If this is _not_ correct: I.e., you have _not_
#completed or are not a good a candidate for this review, please
#contact the submitter, \"$author\".
#
#Thanks!
#
#MSG
#      if (defined($url)) { $msg .= "$url\n"; }
#      &msg("revby-to: $to\n", $Log, $Notty);
#      &msg("revby-cc: $author\n", $Log, $Notty);
#
#      print MAIL "\n--------------------\n".`$P4 describe -s $changenum`."\n";
#
#      print MAIL $msg;
#      close(MAIL);
#    }
#      
#  if ($#revrq >= 0)
#    {
#      if (! open(MAIL, "| $cmd")) { next; } 
#      my $to = join(", ", @revrq);
#      my $msg = <<MSG;
#To: $to
#cc: $author
#From: $From
#Reply-To: $email ($fullname)
#Subject: Deferred Review Request for change $changenum by $author
#
#Newly submitted change list $changenum lists you as a candidate
#reviewer.
#
#Please perform this code review at your earliest convenience,
#and signify completion by running
#
#  \$ p4_review $changenum
#
#which will remove your name from the "review-req:" field (deleting the
#field if this empties it), and add it to the "reviewed-by:" field
#(creating it if it doesn't already exist).
#
#Thanks!
#
#MSG
#      if (defined($url)) { $msg .= "$url\n"; }
#      &msg("revreq-to: $to\n", $Log, $Notty);
#      &msg("revreq-cc: $author\n", $Log, $Notty);
#      print MAIL $msg;
#      close(MAIL);
#      &msg("reviewto: to $to author $author\n", $Log, $Notty);
#    }
}


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));
}


sub mail
{
  my($to, $subject, $msg) = @_;

  $subject =~ s/\n+$//;

  if (! defined($msg)) { $msg = "\n$subject\n"; }

  if (! open(MAIL, "|$Sendmail $to"))
    {
      &msg("$Myname: Can't open \"|$Sendmail $to\": $!.\n", $Log);
      return;
    }

  &nodups_reset;
  $to = &nodups_str(split(/\s+/, $to));

  print MAIL <<MSG;
To: $to
Subject: $subject

$msg
MSG
  close MAIL;
  return $?;
}