pjs/webtools/bugzilla/processmail

839 строки
26 KiB
Perl
Executable File

#!/usr/bonsaitools/bin/perl -wT
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>,
# Bryce Nesbitt <bryce-mozilla@nextbus.com>
# Dan Mosedale <dmose@mozilla.org>
# Alan Raetz <al_raetz@yahoo.com>
# Jacob Steenhagen <jake@actex.net>
# Matthew Tuck <matty@chariot.net.au>
use diagnostics;
use strict;
use lib ".";
require "globals.pl";
use RelationSet;
# Shut up misguided -w warnings about "used only once".
sub processmail_sillyness {
my $zz;
$zz = $::db;
}
$| = 1;
umask(0);
my $nametoexclude = "";
my %nomail;
my @excludedAddresses = ();
# disable email flag for offline debugging work
my $enableSendMail = 1;
my %force;
@{$force{'QAcontact'}} = ();
@{$force{'Owner'}} = ();
@{$force{'Reporter'}} = ();
@{$force{'CClist'}} = ();
@{$force{'Voter'}} = ();
my %seen;
my @sentlist;
sub FormatTriple {
my ($a, $b, $c) = (@_);
$^A = "";
my $temp = formline << 'END', $a, $b, $c;
^>>>>>>>>>>>>>>>>>>|^<<<<<<<<<<<<<<<<<<<<<<<<<<<|^<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
END
; # This semicolon appeases my emacs editor macros. :-)
return $^A;
}
sub FormatDouble {
my ($a, $b) = (@_);
$a .= ":";
$^A = "";
my $temp = formline << 'END', $a, $b;
^>>>>>>>>>>>>>>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
END
; # This semicolon appeases my emacs editor macros. :-)
return $^A;
}
sub ProcessOneBug {
my ($id) = (@_);
my @headerlist;
my %values;
my %defmailhead;
my %fielddescription;
my $msg = "";
SendSQL("SELECT name, description, mailhead FROM fielddefs " .
"ORDER BY sortkey");
while (MoreSQLData()) {
my ($field, $description, $mailhead) = (FetchSQLData());
push(@headerlist, $field);
$defmailhead{$field} = $mailhead;
$fielddescription{$field} = $description;
}
SendSQL("SELECT " . join(',', @::log_columns) . ", lastdiffed, now() " .
"FROM bugs WHERE bug_id = $id");
my @row = FetchSQLData();
foreach my $i (@::log_columns) {
$values{$i} = shift(@row);
}
my ($start, $end) = (@row);
# $start and $end are considered safe because users can't touch them
trick_taint($start);
trick_taint($end);
my $ccSet = new RelationSet();
$ccSet->mergeFromDB("SELECT who FROM cc WHERE bug_id = $id");
$values{'cc'} = $ccSet->toString();
my @voterList;
SendSQL("SELECT profiles.login_name FROM votes, profiles " .
"WHERE votes.bug_id = $id AND profiles.userid = votes.who");
while (MoreSQLData()) {
push(@voterList, FetchOneColumn());
}
$values{'assigned_to'} = DBID_to_name($values{'assigned_to'});
$values{'reporter'} = DBID_to_name($values{'reporter'});
if ($values{'qa_contact'}) {
$values{'qa_contact'} = DBID_to_name($values{'qa_contact'});
}
my @diffs;
SendSQL("SELECT profiles.login_name, fielddefs.description, " .
" bug_when, removed, added, attach_id " .
"FROM bugs_activity, fielddefs, profiles " .
"WHERE bug_id = $id " .
" AND fielddefs.fieldid = bugs_activity.fieldid " .
" AND profiles.userid = who " .
" AND bug_when > '$start' " .
" AND bug_when <= '$end' " .
"ORDER BY bug_when"
);
while (MoreSQLData()) {
my @row = FetchSQLData();
push(@diffs, \@row);
}
my $difftext = "";
my $lastwho = "";
foreach my $ref (@diffs) {
my ($who, $what, $when, $old, $new, $attachid) = (@$ref);
if ($who ne $lastwho) {
$lastwho = $who;
$difftext .= "\n$who" . Param('emailsuffix') . " changed:\n\n";
$difftext .= FormatTriple("What ", "Removed", "Added");
$difftext .= ('-' x 76) . "\n";
}
$what =~ s/^Attachment/Attachment #$attachid/ if (Param('useattachmenttracker') && $attachid);
$difftext .= FormatTriple($what, $old, $new);
}
$difftext = trim($difftext);
my $deptext = "";
my $resid =
SendSQL("SELECT bugs_activity.bug_id, bugs.short_desc, fielddefs.name, " .
" removed, added " .
"FROM bugs_activity, bugs, dependencies, fielddefs ".
"WHERE bugs_activity.bug_id = dependencies.dependson " .
" AND bugs.bug_id = bugs_activity.bug_id ".
" AND dependencies.blocked = $id " .
" AND fielddefs.fieldid = bugs_activity.fieldid" .
" AND (fielddefs.name = 'bug_status' " .
" OR fielddefs.name = 'resolution') " .
" AND bug_when > '$start' " .
" AND bug_when <= '$end' " .
"ORDER BY bug_when, bug_id");
my $thisdiff = "";
my $lastbug = "";
my $interestingchange = 0;
while (MoreSQLData()) {
my ($bug, $summary, $what, $old, $new) = (FetchSQLData());
if ($bug ne $lastbug) {
if ($interestingchange) {
$deptext .= $thisdiff;
}
$lastbug = $bug;
$thisdiff =
"\nThis bug depends on bug $bug, which changed state.\n";
$thisdiff .=
"Bug $bug Summary: $summary\n\n";
$thisdiff .= FormatTriple("What ", "Old Value", "New Value");
$thisdiff .= ('-' x 76) . "\n";
$interestingchange = 0;
}
$thisdiff .= FormatTriple($fielddescription{$what}, $old, $new);
if ($what eq 'bug_status' && IsOpenedState($old) ne IsOpenedState($new)) {
$interestingchange = 1;
}
}
if ($interestingchange) {
$deptext .= $thisdiff;
}
$deptext = trim($deptext);
if ($deptext) {
$difftext = trim($difftext . "\n\n" . $deptext);
}
my $newcomments = GetLongDescriptionAsText($id, $start, $end);
#
# Start of email filtering code
#
my $count = 0;
my @currentEmailAttributes = getEmailAttributes($newcomments, @diffs);
my (@assigned_toList,@reporterList,@qa_contactList,@ccList) = ();
#open(LOG, ">>/tmp/maillog");
#print LOG "\nBug ID: $id CurrentEmailAttributes:";
#print LOG join(',', @currentEmailAttributes) . "\n";
@excludedAddresses = (); # zero out global list
@assigned_toList = filterEmailGroup('Owner',
\@currentEmailAttributes,
$values{'assigned_to'});
@reporterList = filterEmailGroup('Reporter',
\@currentEmailAttributes,
$values{'reporter'});
if (Param('useqacontact') && $values{'qa_contact'}) {
@qa_contactList = filterEmailGroup('QAcontact',
\@currentEmailAttributes,
$values{'qa_contact'});
} else {
@qa_contactList = ();
}
@ccList = filterEmailGroup('CClist', \@currentEmailAttributes,
$values{'cc'});
@voterList = filterEmailGroup('Voter', \@currentEmailAttributes,
join(',',@voterList));
my @emailList = (@assigned_toList, @reporterList,
@qa_contactList, @ccList, @voterList);
# only need one entry per person
my @allEmail = ();
my %AlreadySeen = ();
foreach my $person (@emailList) {
if ( !($AlreadySeen{$person}) ) {
push(@allEmail,$person);
$AlreadySeen{$person}++;
}
}
#print LOG "\nbug $id email sent: " . join(',', @allEmail) . "\n";
@excludedAddresses = filterExcludeList(\@excludedAddresses,
\@allEmail);
# print LOG "excluded: " . join(',',@excludedAddresses) . "\n\n";
foreach my $person ( @allEmail ) {
my @reasons;
$count++;
push(@reasons, 'AssignedTo') if lsearch(\@assigned_toList, $person) != -1;
push(@reasons, 'Reporter') if lsearch(\@reporterList, $person) != -1;
push(@reasons, 'QAContact') if lsearch(\@qa_contactList, $person) != -1;
push(@reasons, 'CC') if lsearch(\@ccList, $person) != -1;
push(@reasons, 'Voter') if lsearch(\@voterList, $person) != -1;
if ( !defined(NewProcessOnePerson($person, $count, \@headerlist,
\@reasons, \%values,
\%defmailhead,
\%fielddescription, $difftext,
$newcomments, $start, $id))) {
# if a value is not returned, this means that the person
# was not sent mail. add them to the excludedAddresses list.
# it will be filtered later for dups.
#
push @excludedAddresses, $person;
}
}
SendSQL("UPDATE bugs SET lastdiffed = '$end', delta_ts = delta_ts " .
"WHERE bug_id = $id");
# Filter the exclude list for dupes one last time
@excludedAddresses = filterExcludeList(\@excludedAddresses,
\@sentlist);
if (@sentlist) {
print "<b>Email sent to:</b> " . join(", ", @sentlist) ."<br>\n";
} else {
print "<b>Email sent to:</b> no one<br>\n";
}
if (@excludedAddresses) {
print "<b>Excluding:</b> " . join(", ", @excludedAddresses) . "\n";
}
print "<br><center>If you wish to tweak the kinds of mail Bugzilla sends you, you can";
print " <a href=\"userprefs.cgi?bank=diffs\">change your preferences</a></center>\n";
}
# When one person is in different fields on one bug, they may be
# excluded from email because of one relationship to the bug (eg
# they're the QA contact) but included because of another (eg they
# also reported the bug). Inclusion takes precedence, so this
# function looks for and removes any users from the exclude list who
# are also on the include list. Additionally, it removes duplicate
# entries from the exclude list.
#
# Arguments are the exclude list and the include list; the cleaned up
# exclude list is returned.
#
sub filterExcludeList ($$) {
if ($#_ != 1) {
die ("filterExcludeList called with wrong number of args");
}
my ($refExcluded, $refAll) = @_;
my @excludedAddrs = @$refExcluded;
my @allEmail = @$refAll;
my @tmpList = @excludedAddrs;
my (@result,@uniqueResult) = ();
my %alreadySeen;
foreach my $excluded (@tmpList) {
push (@result,$excluded);
foreach my $included (@allEmail) {
# match found, so we remove the entry
if ($included eq $excluded) {
pop(@result);
last;
}
}
}
# only need one entry per person
foreach my $person (@result) {
if ( !($alreadySeen{$person}) ) {
push(@uniqueResult,$person);
$alreadySeen{$person}++;
}
}
return @uniqueResult;
}
# if the Status was changed to Resolved or Verified
# set the Resolved flag
#
# else if Severity, Status OR Priority fields have any change
# set the Status flag
#
# else if Keywords has changed
# set the Keywords flag
#
# else if CC has changed
# set the CC flag
#
# if the Comments field shows an attachment
# set the Attachment flag
#
# else if Comments exist
# set the Comments flag
#
# if no flags are set and there was some other field change
# set the Status flag
#
sub getEmailAttributes ($@) {
my ($commentField,@fieldDiffs) = @_;
my (@flags,@uniqueFlags,%alreadySeen) = ();
foreach my $ref (@fieldDiffs) {
my ($who, $fieldName, $when, $old, $new) = (@$ref);
#print qq{field: $fieldName $new<br>};
# the STATUS will be flagged for Severity, Status and
# Priority changes
#
if ( $fieldName eq 'Status') {
if ($new eq 'RESOLVED' || $new eq 'VERIFIED') {
push (@flags, 'Resolved');
}
}
elsif ( $fieldName eq 'Severity' || $fieldName eq 'Status' ||
$fieldName eq 'Priority' ) {
push (@flags, 'Status');
} elsif ( $fieldName eq 'Keywords') {
push (@flags, 'Keywords');
} elsif ( $fieldName eq 'CC') {
push (@flags, 'CC');
}
# These next few lines are for finding out who's been added
# to the Owner, QA, CC, etc. fields. It does not effect
# the @flags array at all, but is run here because it does
# effect filtering later and we're already in the loop.
if ($fieldName eq 'Owner') {
push (@{$force{'Owner'}}, $new);
} elsif ($fieldName eq 'QAContact') {
push (@{$force{'QAContact'}}, $new);
} elsif ($fieldName eq 'CC') {
my @added = split (/[ ,]/, $new);
push (@{$force{'CClist'}}, @added);
}
}
if ( $commentField =~ /Created an attachment \(/ ) {
push (@flags, 'Attachments');
}
elsif ( ($commentField ne '') && !(scalar(@flags) == 1 && $flags[0] eq 'Resolved')) {
push (@flags, 'Comments');
}
# default fallthrough for any unflagged change is 'Other'
if ( @flags == 0 && @fieldDiffs != 0 ) {
push (@flags, 'Other');
}
# only need one flag per attribute type
foreach my $flag (@flags) {
if ( !($alreadySeen{$flag}) ) {
push(@uniqueFlags,$flag);
$alreadySeen{$flag}++;
}
}
#print "\nEmail Attributes: ", join(' ,',@uniqueFlags), "<br>\n";
# catch-all default, just in case the above logic is faulty
if ( @uniqueFlags == 0) {
push (@uniqueFlags, 'Comments');
}
return @uniqueFlags;
}
sub filterEmailGroup ($$$) {
my ($emailGroup,$refAttributes,$emailList) = @_;
my @emailAttributes = @$refAttributes;
my @emailList = split(/,/,$emailList);
my @filteredList = ();
# the force list for this email group needs to be checked as well
#
push @emailList, @{$force{$emailGroup}};
# Check this user for any watchers... doing this here allows them to inhert the
# relationship to the bug of the person they are watching (if the person they
# are watching is an owner, their mail is filtered as if they were the owner).
if (Param("supportwatchers")) {
my @watchers;
foreach my $person(@emailList) {
my $personId = DBname_to_id($person);
SendSQL("SELECT watcher FROM watch WHERE watched = $personId");
while(MoreSQLData()) {
my ($watcher) = FetchSQLData();
if ($watcher) {
push (@watchers, DBID_to_name($watcher));
}
}
}
push(@emailList, @watchers);
}
foreach my $person (@emailList) {
my $lastCount = @filteredList;
if ( $person eq '' ) { next; }
my $userid = DBname_to_id($person);
if ( ! $userid ) {
push(@filteredList,$person);
next;
}
SendSQL("SELECT emailflags FROM profiles WHERE " .
"userid = $userid" );
my ($userFlagString) = FetchSQLData();
# If the sender doesn't want email, exclude them from list
if (lc($person) eq $nametoexclude) {
if ( defined ($userFlagString) &&
$userFlagString =~ /ExcludeSelf\~on/ ) {
push (@excludedAddresses,$person);
next;
}
}
# if the users database entry is empty, send them all email
# by default (they have not accessed userprefs.cgi recently).
if ( !defined($userFlagString) || !($userFlagString =~ /email/) ) {
push(@filteredList,$person);
}
else {
# the 255 param is here, because without a third param,
# split will trim any trailing null fields, which causes perl
# to eject lots of warnings. any suitably large number would
# do.
my %userFlags = split(/~/, $userFlagString, 255);
# The default condition is to send each person email.
# If we match the email attribute with the user flag, and
# they do not want email, then remove them from the list.
push(@filteredList,$person);
my $detectedOn = 0;
foreach my $attribute (@emailAttributes) {
my $matchName = 'email' . $emailGroup . $attribute;
# **** Kludge... quick and dirty fix for 2.12
# http://bugzilla.mozilla.org/show_bug.cgi?id=73665
# If this pref is new (it's been added since this user
# last updated their filtering prefs, $userFlags{$matchName}
# will be undefined. This should be considered a match
# so that new prefs will default to 'on'
if (!defined($userFlags{$matchName})) {
$detectedOn = 1;
}
while ((my $flagName, my $flagValue) = each %userFlags) {
if ($flagName !~ /$emailGroup/) {
next;
}
if ($flagName eq $matchName){
if ($flagValue eq 'on') {
$detectedOn = 1;
}
}
} # for each userFlag
} # for each email attribute
# if the current flag hasn't been detected on at least once,
# this person gets filtered from this group.
#
if (! $detectedOn) {
pop(@filteredList);
}
# check to see if the person was added to or removed from
# this email group.
# Note: This was originally written as only removed from
# and was rewritten to be Added/Removed, but for simplicity
# sake, the name "Removeme" wasn't changed.
# http://bugzilla.mozilla.org/show_bug.cgi?id=71912
if ( grep ($_ eq $person, @{$force{$emailGroup}} ) ) {
# if so, see if they want mail about that
#
if ( $userFlags{'email' . $emailGroup . 'Removeme'} eq 'on' ) {
# we definitely want mail sent to this person, since
# inclusion on a mail takes precedence over the previous
# exclusion
# have they been filtered for some other reason?
#
if (@filteredList == $lastCount) {
# if so, put them back
#
push (@filteredList, $person);
}
}
}
} # if $userFlagString is valid
# has the person been moved off the filtered list?
#
if (@filteredList == $lastCount ) {
# mark them as excluded
#
push (@excludedAddresses,$person);
}
} # for each person
return @filteredList;
}
sub NewProcessOnePerson ($$$$$$$$$$$) {
my ($person, $count, $hlRef, $reasonsRef, $valueRef, $dmhRef, $fdRef, $difftext,
$newcomments, $start, $id) = @_;
my %values = %$valueRef;
my @headerlist = @$hlRef;
my @reasons = @$reasonsRef;
my %defmailhead = %$dmhRef;
my %fielddescription = %$fdRef;
if ($seen{$person}) {
return;
}
if ($nomail{$person}) {
return;
}
SendSQL("SELECT userid, groupset " .
"FROM profiles WHERE login_name = " . SqlQuote($person));
my ($userid, $groupset) = (FetchSQLData());
$seen{$person} = 1;
detaint_natural($userid);
detaint_natural($groupset);
# if this person doesn't have permission to see info on this bug,
# return.
#
# XXX - This currently means that if a bug is suddenly given
# more restrictive permissions, people without those permissions won't
# see the action of restricting the bug itself; the bug will just
# quietly disappear from their radar.
#
return unless CanSeeBug($id, $userid, $groupset);
my %mailhead = %defmailhead;
my $head = "";
foreach my $f (@headerlist) {
if ($mailhead{$f}) {
my $value = $values{$f};
# If there isn't anything to show, don't include this header
if (! $value) {
next;
}
my $desc = $fielddescription{$f};
$head .= FormatDouble($desc, $value);
}
}
if ($difftext eq "" && $newcomments eq "") {
# Whoops, no differences!
return;
}
my $reasonsbody = "------- You are receiving this mail because: -------\n";
if (scalar(@reasons) == 0) {
$reasonsbody .= "Whoops! I have no idea!\n";
} else {
foreach my $reason (@reasons) {
if ($reason eq 'AssignedTo') {
$reasonsbody .= "You are the assignee for the bug, or are watching the assignee.\n";
} elsif ($reason eq 'Reporter') {
$reasonsbody .= "You reported the bug, or are watching the reporter.\n";
} elsif ($reason eq 'QAContact') {
$reasonsbody .= "You are the QA contact for the bug, or are watching the QA contact.\n";
} elsif ($reason eq 'CC') {
$reasonsbody .= "You are on the CC list for the bug, or are watching someone who is.\n";
} elsif ($reason eq 'Voter') {
$reasonsbody .= "You are a voter for the bug, or are watching someone who is.\n";
} else {
$reasonsbody .= "Whoops! There is an unknown reason!\n";
}
}
}
my $isnew = ($start !~ m/[1-9]/);
my %substs;
# If an attachment was created, then add an URL. (Note: the 'g'lobal
# replace should work with comments with multiple attachments.)
if ( $newcomments =~ /Created an attachment \(/ ) {
my $showattachurlbase =
Param('urlbase') . "showattachment.cgi?attach_id=";
$newcomments =~ s/(Created an attachment \(id=([0-9]+)\))/$1\n --> \(${showattachurlbase}$2\)/g;
}
$person .= Param('emailsuffix');
# 09/13/2000 cyeh@bluemartini.com
# If a bug is changed, don't put the word "Changed" in the subject mail
# since if the bug didn't change, you wouldn't be getting mail
# in the first place! see http://bugzilla.mozilla.org/show_bug.cgi?id=29820
# for details.
$substs{"neworchanged"} = $isnew ? 'New: ' : '';
$substs{"to"} = $person;
$substs{"cc"} = '';
$substs{"bugid"} = $id;
if ($isnew) {
$substs{"diffs"} = $head . "\n\n" . $newcomments;
} else {
$substs{"diffs"} = $difftext . "\n\n" . $newcomments;
}
$substs{"summary"} = $values{'short_desc'};
$substs{"reasonsheader"} = join(" ", @reasons);
$substs{"reasonsbody"} = $reasonsbody;
my $template = Param("newchangedmail");
my $msg = PerformSubsts($template, \%substs);
my $sendmailparam = "-ODeliveryMode=deferred";
if (Param("sendmailnow")) {
$sendmailparam = "";
}
if ($enableSendMail == 1) {
open(SENDMAIL, "|/usr/lib/sendmail $sendmailparam -t") ||
die "Can't open sendmail";
print SENDMAIL trim($msg) . "\n";
close SENDMAIL;
}
push(@sentlist, $person);
return 1;
}
# Code starts here
ConnectToDatabase();
# Set Taint mode for the SQL
$::db->{Taint} = 1;
# ^^^ Taint mode is still a work in progress...
GetVersionTable();
if (open(FID, "<data/nomail")) {
while (<FID>) {
$nomail{trim($_)} = 1;
}
close FID;
}
if ($#ARGV >= 0 && $ARGV[0] eq "regenerate") {
print "Regenerating is no longer required or supported\n";
exit;
}
if ($#ARGV >= 0 && $ARGV[0] eq "-forcecc") {
shift(@ARGV);
foreach my $i (split(/,/, shift(@ARGV))) {
push(@{$force{'CClist'}}, trim($i));
}
}
if ($#ARGV >= 0 && $ARGV[0] eq "-forceowner") {
shift(@ARGV);
@{$force{'Owner'}} = (trim(shift(@ARGV)));
}
if ($#ARGV >= 0 && $ARGV[0] eq "-forceqacontact") {
shift(@ARGV);
@{$force{'QAcontact'}} = (trim(shift(@ARGV)));
}
if (($#ARGV < 0) || ($#ARGV > 1)) {
print "Usage:\n processmail {bugid} {nametoexclude} " .
"[-forcecc list,of,users]\n [-forceowner name] " .
"[-forceqacontact name]\nor\n" .
" processmail rescanall\n";
exit;
}
if ($#ARGV == 1) {
$nametoexclude = lc($ARGV[1]);
}
if ($ARGV[0] eq "rescanall") {
print "<br> Collecting bug ids...\n";
SendSQL("select bug_id from bugs where to_days(now()) - to_days(delta_ts) <= 2 order by bug_id");
my @list;
while (my @row = FetchSQLData()) {
push @list, $row[0];
}
foreach my $id (@list) {
if (detaint_natural($id)) {
print "<br> Doing bug $id\n";
ProcessOneBug($id);
}
}
} else {
my $bugnum;
if ($ARGV[0] =~ m/^([1-9][0-9]*)$/) {
$bugnum = $1;
} else {
print "Error calling processmail (bug id is not an integer)<br>\n";
exit;
}
ProcessOneBug($bugnum);
}
exit;