1
#!/usr/bonsaitools/bin/perl -wT
2
# -*- Mode: perl; indent-tabs-mode: nil -*-
4
# The contents of this file are subject to the Mozilla Public
5
# License Version 1.1 (the "License"); you may not use this file
6
# except in compliance with the License. You may obtain a copy of
7
# the License at http://www.mozilla.org/MPL/
9
# Software distributed under the License is distributed on an "AS
10
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
11
# implied. See the License for the specific language governing
12
# rights and limitations under the License.
14
# The Original Code is the Bugzilla Bug Tracking System.
16
# The Initial Developer of the Original Code is Netscape Communications
17
# Corporation. Portions created by Netscape are
18
# Copyright (C) 1998 Netscape Communications Corporation. All
21
# Contributor(s): Terry Weissman <terry@mozilla.org>,
22
# Bryce Nesbitt <bryce-mozilla@nextbus.com>
23
# Dan Mosedale <dmose@mozilla.org>
24
# Alan Raetz <al_raetz@yahoo.com>
25
# Jacob Steenhagen <jake@actex.net>
26
# Matthew Tuck <matty@chariot.net.au>
37
# Shut up misguided -w warnings about "used only once".
38
sub processmail_sillyness {
47
my $nametoexclude = "";
50
my @excludedAddresses = ();
52
# disable email flag for offline debugging work
53
my $enableSendMail = 1;
56
@{$force{'QAcontact'}} = ();
57
@{$force{'Owner'}} = ();
58
@{$force{'Reporter'}} = ();
59
@{$force{'CClist'}} = ();
60
@{$force{'Voter'}} = ();
67
my ($a, $b, $c) = (@_);
69
my $temp = formline << 'END', $a, $b, $c;
70
^>>>>>>>>>>>>>>>>>>|^<<<<<<<<<<<<<<<<<<<<<<<<<<<|^<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
72
; # This semicolon appeases my emacs editor macros. :-)
80
my $temp = formline << 'END', $a, $b;
81
^>>>>>>>>>>>>>>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
83
; # This semicolon appeases my emacs editor macros. :-)
98
SendSQL("SELECT name, description, mailhead FROM fielddefs " .
100
while (MoreSQLData()) {
101
my ($field, $description, $mailhead) = (FetchSQLData());
102
push(@headerlist, $field);
103
$defmailhead{$field} = $mailhead;
104
$fielddescription{$field} = $description;
106
SendSQL("SELECT " . join(',', @::log_columns) . ", lastdiffed, now() " .
107
"FROM bugs WHERE bug_id = $id");
108
my @row = FetchSQLData();
109
foreach my $i (@::log_columns) {
110
$values{$i} = shift(@row);
112
my ($start, $end) = (@row);
113
# $start and $end are considered safe because users can't touch them
117
my $ccSet = new RelationSet();
118
$ccSet->mergeFromDB("SELECT who FROM cc WHERE bug_id = $id");
119
$values{'cc'} = $ccSet->toString();
122
SendSQL("SELECT profiles.login_name FROM votes, profiles " .
123
"WHERE votes.bug_id = $id AND profiles.userid = votes.who");
124
while (MoreSQLData()) {
125
push(@voterList, FetchOneColumn());
128
$values{'assigned_to'} = DBID_to_name($values{'assigned_to'});
129
$values{'reporter'} = DBID_to_name($values{'reporter'});
130
if ($values{'qa_contact'}) {
131
$values{'qa_contact'} = DBID_to_name($values{'qa_contact'});
137
SendSQL("SELECT profiles.login_name, fielddefs.description, " .
138
" bug_when, removed, added, attach_id " .
139
"FROM bugs_activity, fielddefs, profiles " .
140
"WHERE bug_id = $id " .
141
" AND fielddefs.fieldid = bugs_activity.fieldid " .
142
" AND profiles.userid = who " .
143
" AND bug_when > '$start' " .
144
" AND bug_when <= '$end' " .
148
while (MoreSQLData()) {
149
my @row = FetchSQLData();
155
foreach my $ref (@diffs) {
156
my ($who, $what, $when, $old, $new, $attachid) = (@$ref);
157
if ($who ne $lastwho) {
159
$difftext .= "\n$who" . Param('emailsuffix') . " changed:\n\n";
160
$difftext .= FormatTriple("What ", "Removed", "Added");
161
$difftext .= ('-' x 76) . "\n";
163
$what =~ s/^Attachment/Attachment #$attachid/ if $attachid;
164
$difftext .= FormatTriple($what, $old, $new);
167
$difftext = trim($difftext);
174
SendSQL("SELECT bugs_activity.bug_id, bugs.short_desc, fielddefs.name, " .
176
"FROM bugs_activity, bugs, dependencies, fielddefs ".
177
"WHERE bugs_activity.bug_id = dependencies.dependson " .
178
" AND bugs.bug_id = bugs_activity.bug_id ".
179
" AND dependencies.blocked = $id " .
180
" AND fielddefs.fieldid = bugs_activity.fieldid" .
181
" AND (fielddefs.name = 'bug_status' " .
182
" OR fielddefs.name = 'resolution') " .
183
" AND bug_when > '$start' " .
184
" AND bug_when <= '$end' " .
185
"ORDER BY bug_when, bug_id");
189
my $interestingchange = 0;
192
while (MoreSQLData()) {
193
my ($summary, $what, $old, $new);
194
($depbug, $summary, $what, $old, $new) = (FetchSQLData());
195
if ($depbug ne $lastbug) {
196
if ($interestingchange) {
197
$deptext .= $thisdiff;
200
my $urlbase = Param("urlbase");
202
"\nBug $id depends on bug $depbug, which changed state.\n\n" .
203
"Bug $depbug Summary: $summary\n" .
204
"${urlbase}show_bug.cgi?id=$depbug\n\n";
205
$thisdiff .= FormatTriple("What ", "Old Value", "New Value");
206
$thisdiff .= ('-' x 76) . "\n";
207
$interestingchange = 0;
209
$thisdiff .= FormatTriple($fielddescription{$what}, $old, $new);
210
if ($what eq 'bug_status' && IsOpenedState($old) ne IsOpenedState($new)) {
211
$interestingchange = 1;
214
push(@depbugs, $depbug);
217
if ($interestingchange) {
218
$deptext .= $thisdiff;
221
$deptext = trim($deptext);
224
$difftext = trim($difftext . "\n\n" . $deptext);
228
my $newcomments = GetLongDescriptionAsText($id, $start, $end);
231
# Start of email filtering code
235
my @currentEmailAttributes = getEmailAttributes($newcomments, @diffs);
236
my (@assigned_toList,@reporterList,@qa_contactList,@ccList) = ();
238
#open(LOG, ">>/tmp/maillog");
239
#print LOG "\nBug ID: $id CurrentEmailAttributes:";
240
#print LOG join(',', @currentEmailAttributes) . "\n";
242
@excludedAddresses = (); # zero out global list
244
@assigned_toList = filterEmailGroup('Owner',
245
\@currentEmailAttributes,
246
$values{'assigned_to'});
247
@reporterList = filterEmailGroup('Reporter',
248
\@currentEmailAttributes,
249
$values{'reporter'});
250
if (Param('useqacontact') && $values{'qa_contact'}) {
251
@qa_contactList = filterEmailGroup('QAcontact',
252
\@currentEmailAttributes,
253
$values{'qa_contact'});
255
@qa_contactList = ();
258
@ccList = filterEmailGroup('CClist', \@currentEmailAttributes,
261
@voterList = filterEmailGroup('Voter', \@currentEmailAttributes,
262
join(',',@voterList));
264
my @emailList = (@assigned_toList, @reporterList,
265
@qa_contactList, @ccList, @voterList);
267
# only need one entry per person
269
my %AlreadySeen = ();
270
foreach my $person (@emailList) {
271
if ( !($AlreadySeen{$person}) ) {
272
push(@allEmail,$person);
273
$AlreadySeen{$person}++;
277
#print LOG "\nbug $id email sent: " . join(',', @allEmail) . "\n";
279
@excludedAddresses = filterExcludeList(\@excludedAddresses,
282
# print LOG "excluded: " . join(',',@excludedAddresses) . "\n\n";
284
foreach my $person ( @allEmail ) {
289
push(@reasons, 'AssignedTo') if lsearch(\@assigned_toList, $person) != -1;
290
push(@reasons, 'Reporter') if lsearch(\@reporterList, $person) != -1;
291
push(@reasons, 'QAContact') if lsearch(\@qa_contactList, $person) != -1;
292
push(@reasons, 'CC') if lsearch(\@ccList, $person) != -1;
293
push(@reasons, 'Voter') if lsearch(\@voterList, $person) != -1;
295
if ( !defined(NewProcessOnePerson($person, $count, \@headerlist,
298
\%fielddescription, $difftext,
299
$newcomments, $start, $id,
303
# if a value is not returned, this means that the person
304
# was not sent mail. add them to the excludedAddresses list.
305
# it will be filtered later for dups.
307
push @excludedAddresses, $person;
313
SendSQL("UPDATE bugs SET lastdiffed = '$end', delta_ts = delta_ts " .
314
"WHERE bug_id = $id");
316
# Filter the exclude list for dupes one last time
317
@excludedAddresses = filterExcludeList(\@excludedAddresses,
320
print "<b>Email sent to:</b> " . join(", ", @sentlist) ."<br>\n";
322
print "<b>Email sent to:</b> no one<br>\n";
325
if (@excludedAddresses) {
326
print "<b>Excluding:</b> " . join(", ", @excludedAddresses) . "\n";
329
print "<br><center>If you wish to tweak the kinds of mail Bugzilla sends you, you can";
330
print " <a href=\"userprefs.cgi?tab=email\">change your preferences</a></center>\n";
334
# When one person is in different fields on one bug, they may be
335
# excluded from email because of one relationship to the bug (eg
336
# they're the QA contact) but included because of another (eg they
337
# also reported the bug). Inclusion takes precedence, so this
338
# function looks for and removes any users from the exclude list who
339
# are also on the include list. Additionally, it removes duplicate
340
# entries from the exclude list.
342
# Arguments are the exclude list and the include list; the cleaned up
343
# exclude list is returned.
345
sub filterExcludeList ($$) {
348
die ("filterExcludeList called with wrong number of args");
351
my ($refExcluded, $refAll) = @_;
353
my @excludedAddrs = @$refExcluded;
354
my @allEmail = @$refAll;
355
my @tmpList = @excludedAddrs;
356
my (@result,@uniqueResult) = ();
359
foreach my $excluded (@tmpList) {
361
push (@result,$excluded);
362
foreach my $included (@allEmail) {
364
# match found, so we remove the entry
365
if ($included eq $excluded) {
372
# only need one entry per person
373
foreach my $person (@result) {
374
if ( !($alreadySeen{$person}) ) {
375
push(@uniqueResult,$person);
376
$alreadySeen{$person}++;
380
return @uniqueResult;
383
# if the Status was changed to Resolved or Verified
384
# set the Resolved flag
386
# else if Severity, Status OR Priority fields have any change
387
# set the Status flag
389
# else if Keywords has changed
390
# set the Keywords flag
392
# else if CC has changed
395
# if the Comments field shows an attachment
396
# set the Attachment flag
398
# else if Comments exist
399
# set the Comments flag
401
# if no flags are set and there was some other field change
402
# set the Status flag
404
sub getEmailAttributes ($@) {
406
my ($commentField,@fieldDiffs) = @_;
407
my (@flags,@uniqueFlags,%alreadySeen) = ();
409
foreach my $ref (@fieldDiffs) {
410
my ($who, $fieldName, $when, $old, $new) = (@$ref);
412
#print qq{field: $fieldName $new<br>};
414
# the STATUS will be flagged for Severity, Status and
417
if ( $fieldName eq 'Status') {
418
if ($new eq 'RESOLVED' || $new eq 'VERIFIED') {
419
push (@flags, 'Resolved');
422
elsif ( $fieldName eq 'Severity' || $fieldName eq 'Status' ||
423
$fieldName eq 'Priority' ) {
424
push (@flags, 'Status');
425
} elsif ( $fieldName eq 'Keywords') {
426
push (@flags, 'Keywords');
427
} elsif ( $fieldName eq 'CC') {
431
# These next few lines are for finding out who's been added
432
# to the Owner, QA, CC, etc. fields. It does not effect
433
# the @flags array at all, but is run here because it does
434
# effect filtering later and we're already in the loop.
435
if ($fieldName eq 'Owner') {
436
push (@{$force{'Owner'}}, $new);
437
} elsif ($fieldName eq 'QAContact') {
438
push (@{$force{'QAContact'}}, $new);
439
} elsif ($fieldName eq 'CC') {
440
my @added = split (/[ ,]/, $new);
441
push (@{$force{'CClist'}}, @added);
445
if ( $commentField =~ /Created an attachment \(/ ) {
446
push (@flags, 'Attachments');
448
elsif ( ($commentField ne '') && !(scalar(@flags) == 1 && $flags[0] eq 'Resolved')) {
449
push (@flags, 'Comments');
452
# default fallthrough for any unflagged change is 'Other'
453
if ( @flags == 0 && @fieldDiffs != 0 ) {
454
push (@flags, 'Other');
457
# only need one flag per attribute type
458
foreach my $flag (@flags) {
459
if ( !($alreadySeen{$flag}) ) {
460
push(@uniqueFlags,$flag);
461
$alreadySeen{$flag}++;
464
#print "\nEmail Attributes: ", join(' ,',@uniqueFlags), "<br>\n";
466
# catch-all default, just in case the above logic is faulty
467
if ( @uniqueFlags == 0) {
468
push (@uniqueFlags, 'Comments');
474
sub filterEmailGroup ($$$) {
476
my ($emailGroup,$refAttributes,$emailList) = @_;
477
my @emailAttributes = @$refAttributes;
478
my @emailList = split(/,/,$emailList);
479
my @filteredList = ();
482
# the force list for this email group needs to be checked as well
484
push @emailList, @{$force{$emailGroup}};
486
# Check this user for any watchers... doing this here allows them to inhert the
487
# relationship to the bug of the person they are watching (if the person they
488
# are watching is an owner, their mail is filtered as if they were the owner).
489
if (Param("supportwatchers")) {
491
foreach my $person(@emailList) {
492
my $personId = DBname_to_id($person);
493
SendSQL("SELECT watcher FROM watch WHERE watched = $personId");
494
while(MoreSQLData()) {
495
my ($watcher) = FetchSQLData();
497
push (@watchers, DBID_to_name($watcher));
501
push(@emailList, @watchers);
505
foreach my $person (@emailList) {
507
my $lastCount = @filteredList;
509
if ( $person eq '' ) { next; }
511
my $userid = DBname_to_id($person);
514
push(@filteredList,$person);
518
SendSQL("SELECT emailflags FROM profiles WHERE " .
519
"userid = $userid" );
521
my ($userFlagString) = FetchSQLData();
523
# If the sender doesn't want email, exclude them from list
525
if (lc($person) eq $nametoexclude) {
527
if ( defined ($userFlagString) &&
528
$userFlagString =~ /ExcludeSelf\~on/ ) {
530
push (@excludedAddresses,$person);
535
# if the users database entry is empty, send them all email
536
# by default (they have not accessed userprefs.cgi recently).
538
if ( !defined($userFlagString) || !($userFlagString =~ /email/) ) {
539
push(@filteredList,$person);
543
# the 255 param is here, because without a third param,
544
# split will trim any trailing null fields, which causes perl
545
# to eject lots of warnings. any suitably large number would
548
my %userFlags = split(/~/, $userFlagString, 255);
550
# The default condition is to send each person email.
551
# If we match the email attribute with the user flag, and
552
# they do not want email, then remove them from the list.
554
push(@filteredList,$person);
558
foreach my $attribute (@emailAttributes) {
560
my $matchName = 'email' . $emailGroup . $attribute;
562
# **** Kludge... quick and dirty fix for 2.12
563
# http://bugzilla.mozilla.org/show_bug.cgi?id=73665
564
# If this pref is new (it's been added since this user
565
# last updated their filtering prefs, $userFlags{$matchName}
566
# will be undefined. This should be considered a match
567
# so that new prefs will default to 'on'
568
if (!defined($userFlags{$matchName})) {
572
while ((my $flagName, my $flagValue) = each %userFlags) {
574
if ($flagName !~ /$emailGroup/) {
578
if ($flagName eq $matchName){
579
if ($flagValue eq 'on') {
584
} # for each userFlag
586
} # for each email attribute
588
# if the current flag hasn't been detected on at least once,
589
# this person gets filtered from this group.
595
# check to see if the person was added to or removed from
597
# Note: This was originally written as only removed from
598
# and was rewritten to be Added/Removed, but for simplicity
599
# sake, the name "Removeme" wasn't changed.
600
# http://bugzilla.mozilla.org/show_bug.cgi?id=71912
602
if ( grep ($_ eq $person, @{$force{$emailGroup}} ) ) {
604
# if so, see if they want mail about that
606
if ( $userFlags{'email' . $emailGroup . 'Removeme'} eq 'on' ) {
608
# we definitely want mail sent to this person, since
609
# inclusion on a mail takes precedence over the previous
612
# have they been filtered for some other reason?
614
if (@filteredList == $lastCount) {
616
# if so, put them back
618
push (@filteredList, $person);
623
} # if $userFlagString is valid
625
# has the person been moved off the filtered list?
627
if (@filteredList == $lastCount ) {
629
# mark them as excluded
631
push (@excludedAddresses,$person);
636
return @filteredList;
639
sub NewProcessOnePerson ($$$$$$$$$$$$) {
640
my ($person, $count, $hlRef, $reasonsRef, $valueRef, $dmhRef, $fdRef, $difftext,
641
$newcomments, $start, $id, $depbugsRef) = @_;
643
my %values = %$valueRef;
644
my @headerlist = @$hlRef;
645
my @reasons = @$reasonsRef;
646
my %defmailhead = %$dmhRef;
647
my %fielddescription = %$fdRef;
648
my @depbugs = @$depbugsRef;
650
if ($seen{$person}) {
654
if ($nomail{$person}) {
659
SendSQL("SELECT userid, groupset " .
660
"FROM profiles WHERE login_name = " . SqlQuote($person));
661
my ($userid, $groupset) = (FetchSQLData());
665
detaint_natural($userid);
666
detaint_natural($groupset);
668
# if this person doesn't have permission to see info on this bug,
671
# XXX - This currently means that if a bug is suddenly given
672
# more restrictive permissions, people without those permissions won't
673
# see the action of restricting the bug itself; the bug will just
674
# quietly disappear from their radar.
676
return unless CanSeeBug($id, $userid, $groupset);
678
# We shouldn't send changedmail if this is a dependency mail, and any of
679
# the depending bugs is not visible to the user.
680
foreach my $dep_id (@depbugs) {
681
my $save_id = $dep_id;
682
detaint_natural($dep_id) || warn("Unexpected Error: \@depbugs contains a non-numeric value: '$save_id'")
684
return unless CanSeeBug($dep_id, $userid, $groupset);
687
my %mailhead = %defmailhead;
691
foreach my $f (@headerlist) {
693
my $value = $values{$f};
694
# If there isn't anything to show, don't include this header
698
my $desc = $fielddescription{$f};
699
$head .= FormatDouble($desc, $value);
703
if ($difftext eq "" && $newcomments eq "") {
704
# Whoops, no differences!
708
my $reasonsbody = "------- You are receiving this mail because: -------\n";
710
if (scalar(@reasons) == 0) {
711
$reasonsbody .= "Whoops! I have no idea!\n";
713
foreach my $reason (@reasons) {
714
if ($reason eq 'AssignedTo') {
715
$reasonsbody .= "You are the assignee for the bug, or are watching the assignee.\n";
716
} elsif ($reason eq 'Reporter') {
717
$reasonsbody .= "You reported the bug, or are watching the reporter.\n";
718
} elsif ($reason eq 'QAContact') {
719
$reasonsbody .= "You are the QA contact for the bug, or are watching the QA contact.\n";
720
} elsif ($reason eq 'CC') {
721
$reasonsbody .= "You are on the CC list for the bug, or are watching someone who is.\n";
722
} elsif ($reason eq 'Voter') {
723
$reasonsbody .= "You are a voter for the bug, or are watching someone who is.\n";
725
$reasonsbody .= "Whoops! There is an unknown reason!\n";
730
my $isnew = ($start !~ m/[1-9]/);
734
# If an attachment was created, then add an URL. (Note: the 'g'lobal
735
# replace should work with comments with multiple attachments.)
737
if ( $newcomments =~ /Created an attachment \(/ ) {
739
my $showattachurlbase =
740
Param('urlbase') . "attachment.cgi?id=";
742
$newcomments =~ s/(Created an attachment \(id=([0-9]+)\))/$1\n --> \(${showattachurlbase}$2&action=view\)/g;
745
$person .= Param('emailsuffix');
746
# 09/13/2000 cyeh@bluemartini.com
747
# If a bug is changed, don't put the word "Changed" in the subject mail
748
# since if the bug didn't change, you wouldn't be getting mail
749
# in the first place! see http://bugzilla.mozilla.org/show_bug.cgi?id=29820
751
$substs{"neworchanged"} = $isnew ? 'New: ' : '';
752
$substs{"to"} = $person;
754
$substs{"bugid"} = $id;
756
$substs{"diffs"} = $head . "\n\n" . $newcomments;
758
$substs{"diffs"} = $difftext . "\n\n" . $newcomments;
760
$substs{"summary"} = $values{'short_desc'};
761
$substs{"reasonsheader"} = join(" ", @reasons);
762
$substs{"reasonsbody"} = $reasonsbody;
764
my $template = Param("newchangedmail");
766
my $msg = PerformSubsts($template, \%substs);
768
my $sendmailparam = "-ODeliveryMode=deferred";
769
if (Param("sendmailnow")) {
773
if ($enableSendMail == 1) {
774
open(SENDMAIL, "|/usr/lib/sendmail $sendmailparam -t -i") ||
775
die "Can't open sendmail";
777
print SENDMAIL trim($msg) . "\n";
780
push(@sentlist, $person);
787
# Set Taint mode for the SQL
789
# ^^^ Taint mode is still a work in progress...
792
if (open(FID, "<data/nomail")) {
794
$nomail{trim($_)} = 1;
799
if ($#ARGV >= 0 && $ARGV[0] eq "regenerate") {
800
print "Regenerating is no longer required or supported\n";
804
if ($#ARGV >= 0 && $ARGV[0] eq "-forcecc") {
806
foreach my $i (split(/,/, shift(@ARGV))) {
807
push(@{$force{'CClist'}}, trim($i));
811
if ($#ARGV >= 0 && $ARGV[0] eq "-forceowner") {
813
@{$force{'Owner'}} = (trim(shift(@ARGV)));
816
if ($#ARGV >= 0 && $ARGV[0] eq "-forceqacontact") {
818
@{$force{'QAcontact'}} = (trim(shift(@ARGV)));
821
if ($#ARGV >= 0 && $ARGV[0] eq "-forcereporter") {
823
@{$force{'Reporter'}} = trim(shift(@ARGV));
826
if (($#ARGV < 0) || ($#ARGV > 1)) {
827
print "Usage:\n processmail {bugid} {nametoexclude} " .
828
"[-forcecc list,of,users]\n [-forceowner name] " .
829
"[-forceqacontact name]\n [-forcereporter name]\nor\n" .
830
" processmail rescanall\n";
835
$nametoexclude = lc($ARGV[1]);
838
if ($ARGV[0] eq "rescanall") {
839
print "Collecting bug ids...\n";
840
SendSQL("select bug_id, lastdiffed, delta_ts from bugs where lastdiffed < delta_ts AND delta_ts < date_sub(now(), INTERVAL 30 minute) order by bug_id");
842
while (my @row = FetchSQLData()) {
844
if ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/) {
845
$time = "$1-$2-$3 $4:$5:$6";
847
print STDERR "Bug $row[0] has unsent mail. lastdiffed is $row[1], delta_ts is $time.\n";
850
if (scalar(@list) > 0) {
851
print STDERR scalar(@list) . " bugs found with possibly unsent mail\n";
852
print STDERR "Updating bugs, sending mail if required\n";
854
print "All appropriate mail appears to have been sent\n"
856
foreach my $id (@list) {
858
if (detaint_natural($id)) {
864
if ($ARGV[0] =~ m/^([1-9][0-9]*)$/) {
867
print "Error calling processmail (bug id is not an integer)<br>\n";
870
ProcessOneBug($bugnum);
added
removed
processmail
