#!/usr/local/bin/perl # -*-Fundamental-*- # $Id: //guest/hari_krishna_dara/perforce/utils/reviewd/p4notifyd.pl#1 $ # 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 # 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 = <] [ p4port ] [ p4config ] $Myspac [ interval ] [ notify ] [ self ] [ from ] $Myspac [ url ] [ subject ] [ help ] USAGE sub usage { print STDERR "$Usage"; exit 1; } sub help { print STDERR < Log actions to p4port The Perforce server to do reviews for p4config Name to use for \$P4CONFIG interval Seconds to sleep between reviews (0 means the same as "once") [60] notify Always send a separate notification to self Allow "Reviews" notifications to the user who submitted a change from Set the From: header on notifications to [p4notifyd] url Include a link to the change using (see below) subject 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:
[,]
[,] ...", 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:
[,]
[,] ...", 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 " option, by default "Perforce change %C". Finally, the daemon can be configured to send notifications of ALL changes unconditionally, with the "notify " option. Such messages have a recognizable Subject: line in the form Subject: [ADMIN] hyperlink to a web based view of the change description: With the "url " option, " 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"; } 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; 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 "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"; } ##### 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() { # Format: "Change x user (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() { # user (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() { 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() { if (/^Description:/) { while () { 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 <>$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 () { &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 <