]> git.somenet.org - irc/bugbot.git/blob - BotModules/BugzillaMailHandler.pl
GITOLITE.txt
[irc/bugbot.git] / BotModules / BugzillaMailHandler.pl
1 #!/usr/bin/perl -w
2 #
3 # The contents of this file are subject to the Mozilla Public
4 # License Version 1.1 (the "License"); you may not use this file
5 # except in compliance with the License. You may obtain a copy of
6 # the License at http://www.mozilla.org/MPL/
7 #
8 # Software distributed under the License is distributed on an "AS
9 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
10 # implied. See the License for the specific language governing
11 # rights and limitations under the License.
12 #
13 # The Original Code is the Mozilla IRC Bot
14 #
15 # The Initial Developer of the Original Code is Max Kanat-Alexander.
16 # Portions developed by Max Kanat-Alexander are Copyright (C) 2005
17 # Max Kanat-Alexander.  All Rights Reserved.
18 #
19 # Contributor(s): Max Kanat-Alexander <mkanat@bugzilla.org>
20 #
21 # This is loosely based off an older bugmail.pl by justdave.
22
23 # bugmail.pl requires that you have X-Bugzilla-Product and
24 # X-Bugzilla-Component headers in your incoming email. In 2.19.2 and above,
25 # this is easy. You just add two lines to your newchangedmail param:
26 # X-Bugzilla-Product: %product%
27 # X-Bugzilla-Component: %component%
28 # If you're running 2.18, you can do the same thing, but you need to
29 # apply the patch from bug 175222 <https://bugzilla.mozilla.org/show_bug.cgi?id=175222>
30 # to your installation.
31
32 use strict;
33 use Fcntl qw(:flock);
34 use File::Basename;
35
36 use Email::MIME;
37
38 #####################################################################
39 # Constants And Initial Setup
40 #####################################################################
41
42 # What separates Product//Component//[Fields], etc. in a log line.
43 use constant FIELD_SEPARATOR => '::::';
44
45 # These are fields that are multi-select fields, so when somebody
46 # adds something to them, the verbs "added to " or "removed from" should 
47 # be used instead of the verb "changed" or "set".
48 # It's a hash, where the names of the fields are the keys, and the values are 1.
49 # The fields are named as they appear in the "What" part of a bugmail "changes"
50 # table.
51 use constant MULTI_FIELDS => {
52     'CC' => 1, 'Group' => 1, 'Keywords' => 1,
53     'BugsThisDependsOn' => 1, 'OtherBugsDependingOnThis' => 1,
54 };
55
56 # Some fields have such long names for the "What" column that their names
57 # wrap. Normally, our code would think that those fields were two different
58 # fields. So, instead, we store a list of strings to use as an argument
59 # to "grep" for the field names that we need to "unwrap."
60 use constant UNWRAP_WHAT => ( 
61     qr/^Attachment .\d+$/, qr/^Attachment .\d+ is$/, qr/^OtherBugsDep/, 
62 );
63
64 # Should be whatever Bugzilla::Util::find_wrap_point (or FindWrapPoint) 
65 # breaks on, in Bugzilla.
66 use constant BREAKING_CHARACTERS => (' ',',','-');
67
68 # The maximum width, in characters, of each field of the "diffs" table.
69 use constant WIDTH_WHAT    => 19;
70 use constant WIDTH_REMOVED => 28;
71 use constant WIDTH_ADDED   => 28;
72
73 # Our one command-line argument.
74 our $debug = $ARGV[0] && $ARGV[0] eq "-d";
75
76 # XXX - This probably should happen in the log directory instead, but that's
77 #       more difficult to figure out reliably.
78 my $bug_log = dirname($0) . '/.bugmail.log';
79
80 #####################################################################
81 # Utility Functions
82 #####################################################################
83
84 # When processing the "diffs" table in a bug, some lines wrap. This
85 # function properly appends the "next" line for unwrapping to an 
86 # existing string.
87 sub append_diffline ($$$$) {
88     my ($append_to, $prev_line, $append_line, $max_width) = @_;
89     my $ret_line = $append_to;
90
91     debug_print("Appending Line: [$append_line] Prev Line: [$prev_line]");
92     debug_print("Prev Line Len: " . length($prev_line) 
93         . " Max Width: $max_width");
94
95     # If the previous line is the width of the entire column, we
96     # assume that we were forcibly wrapped in the middle of a word,
97     # and no space is needed. We only add the space if we were actually
98     # given a non-empty string to append.
99     if ($append_line && length($prev_line) != $max_width) {
100         debug_print("Adding a space unless we find a breaking character.");
101         # However, sometimes even if we have a very short line, if it ended
102         # in a "breaking character" like '-' then we also don't need a space.
103         $ret_line .= " " unless grep($prev_line =~ /$_$/, BREAKING_CHARACTERS);
104     }
105     $ret_line .= $append_line;
106     debug_print("Appended Line: [$ret_line]");
107     return $ret_line;
108 }
109
110 # Prints a string if debugging is on. Appends a newline so you don't have to.
111 sub debug_print ($) {
112     (print STDERR $_[0] . "\n") if $debug;
113 }
114
115 # Helps with generate_log for Flag messages.
116 sub flag_action ($$) {
117     my ($new, $old) = @_;
118
119     my $line = "";
120
121     my ($flag_name, $action, $requestee) = split_flag($new);
122     debug_print("Parsing Flag Change: Name: [$flag_name] Action: [$action]") 
123         if $new;
124
125     if (!$new) {
126         $line .= " cancelled $old";
127     }
128     elsif ($action eq '+') {
129         $line .= " granted $flag_name";
130     }
131     elsif ($action eq '-') {
132         $line .= " denied $flag_name";
133     }
134     else {
135         $line .= " requested $flag_name from";
136         if ($requestee) {
137             $line .= " " . $requestee;
138         }
139         else {
140             $line .= " the wind";
141         }
142     }
143
144     return $line;
145 }
146
147 # Takes the $old and $new from a Flag field and returns a hash,
148 # where the key is the name of the field, and the value is an
149 # array, where the first item is the old flag string, and the
150 # new flag string is the second item.
151 sub parse_flags ($$) {
152     my ($new, $old) = @_;
153
154     my %flags;
155     foreach my $old_item (split /\s*,\s*/, $old) {
156         my ($flag_name) = split_flag($old_item);
157         $flags{$flag_name} = [$old_item, ''];
158     }
159     foreach my $new_item (split /\s*,\s*/, $new) {
160         my ($flag_name) = split_flag($new_item);
161         if (!exists $flags{$flag_name}) {
162             $flags{$flag_name} = ['', $new_item];
163         }
164         else {
165             $flags{$flag_name}[1] = $new_item;
166         }
167     }
168
169     return %flags;
170 }
171
172 # Returns a list: the name of the flag, the action (+/-/?), and
173 # the requestee (if that exists).
174 sub split_flag ($) {
175     my ($flag) = @_;
176     if ($flag) {
177         $flag =~ /\s*([^\?]+)(\+|-|\?)(?:\((.*)\))?$/;
178         return ($1, $2, $3);
179     }
180     return ();
181 }
182
183 # Cuts the whitespace off the ends of a string. 
184 # Lovingly borrowed from Bugzilla::Util.
185 sub trim ($) {
186     my ($str) = @_;
187     if ($str) {
188       $str =~ s/^\s+//g;
189       $str =~ s/\s+$//g;
190     }
191     return $str;
192 }
193
194 #####################################################################
195 # Main Subroutines
196 #####################################################################
197
198 # Returns a hash, where the keys are the names of fields. The values
199 # are lists, where the first item is what was removed and the second
200 # item is what was added.
201 sub parse_diffs ($) {
202     my ($body_lines) = @_;
203     my @body = @$body_lines;
204
205     my %changes = ();
206     my $order = 0;
207     # Read in the What | Removed | Added table.
208     # End|of|table will never get run
209     my @diff_table = grep (/^.*\|.*\|.*$/, @body);
210     # The first line is the "What|Removed|Added" line, so goes away.
211     shift(@diff_table);
212
213     my ($prev_what, $prev_added, $prev_removed);
214     # We can't use foreach because we need to modify @diff_table.
215     while (defined (my $line = shift @diff_table)) {
216         $line =~ /^(.*)\|(.*)\|(.*)$/;
217         my ($what, $removed, $added) = (trim($1), trim($2), trim($3));
218         # These are used to set $prev_removed and $prev_added later.
219         my ($this_removed, $this_added) = ($removed, $added);
220         
221         debug_print("---RawLine: $what|$removed|$added\n");
222
223         # If we have a field name in the What field.
224         if ($what) {
225             $order++;
226             # If this is a two-line "What" field...
227             if( grep($what =~ $_, UNWRAP_WHAT) ) {
228                 # Then we need to grab the next line right now.
229                 my $next_line = shift @diff_table;
230                 debug_print("Next Line: $next_line");
231                 $next_line =~ /^(.*)\|(.*)\|(.*)$/;
232                 my ($next_what, $next_removed, $next_added) = 
233                     (trim($1), trim($2), trim($3));
234
235                 debug_print("Two-line What: [$what][$next_what]");
236                 $what    = append_diffline($what, $what, $next_what, 
237                                            WIDTH_WHAT);
238                 if ($next_added) {
239                     debug_print("Two-line Added: [$added][$next_added]");
240                     $added   = append_diffline($added, $added, 
241                                                $next_added, WIDTH_ADDED);
242                 }
243                 if ($next_removed) {
244                     debug_print("Two-line Removed: [$removed][$next_removed]");
245                     $removed = append_diffline($removed, $removed, 
246                         $next_removed, WIDTH_REMOVED);
247                 }
248             }
249
250             $changes{$order} = [$what, $removed, $added];
251             debug_print("Filed as $what: $removed => $added");
252
253             # We only set $prev_what if we actually had a $what to put in it.
254             $prev_what = $what;
255         }
256         # Otherwise we're getting data from a previous What.
257         else {
258             my $prev_what = $changes{$order}[0];
259             my $new_removed = append_diffline($changes{$order}[1],
260                 $prev_removed, $removed, WIDTH_REMOVED);
261             my $new_added   = append_diffline($changes{$order}[2],
262                 $prev_added, $added, WIDTH_ADDED);
263
264             $changes{$order} = [$prev_what, $new_removed, $new_added];
265             debug_print("Filed as $prev_what: $removed => $added");
266         }
267
268         ($prev_removed, $prev_added) = ($this_removed, $this_added);
269     }
270
271     return %changes;
272 }
273
274 # Takes a reference to an array of lines and returns a hashref
275 # containing data for a buglog entry.
276 # Returns undef if the bug should not be entered into the log.
277 sub parse_mail ($) {
278     my ($mail_lines) = @_;
279     my $mail_text = join('', @$mail_lines);
280     my $email = Email::MIME->new($mail_text);
281
282     debug_print("Parsing Message " . $email->header('Message-ID'));
283
284     my $body = $email->body;
285     my @body_lines = split("\n", $body);
286
287     my %bug_info;
288
289     # Bug ID
290     my $subject = $email->header('Subject');
291
292     if ($subject !~ /^\s*\[Bug (\d+)\] /i) {
293         debug_print("Not bug: $subject");
294         return undef;
295     }
296     $bug_info{'bug_id'} = $1;
297     debug_print("Bug $bug_info{bug_id} found.");
298
299     # Ignore Dependency mails
300     # XXX - This should probably be an option in the mozbot instead
301     if (my ($dep_line) = 
302         grep /bug (\d+), which changed state\.\s*$/, @body_lines) 
303     {
304         debug_print("Dependency change ignored: $dep_line.");
305         return undef;
306     }
307
308     # Product
309     $bug_info{'product'} = $email->header('X-Bugzilla-Product');
310     unless ($bug_info{'product'}) {
311         debug_print("X-Bugzilla-Product header not found.");
312         return undef;
313     }
314     debug_print("Product '$bug_info{product}' found.");
315
316     # Component
317     $bug_info{'component'} = $email->header('X-Bugzilla-Component');
318     unless ($bug_info{'component'}) {
319         debug_print("X-Bugzilla-Component header not found.");
320         return undef;
321     }
322     debug_print("Component '$bug_info{component}' found.");
323
324     # Who
325     $bug_info{'who'} = $email->header('X-Bugzilla-Who');
326
327     # New or Changed
328     # For Bugzilla vers < 3.0, this code also decides who
329     if ($subject =~ /^\s*\[Bug \d+\]\s*New: /i) {
330         $bug_info{'new'} = 1;
331         debug_print("Bug is New.");
332         unless ($bug_info{'who'}) {
333                 my ($reporter) = grep /^\s+ReportedBy:\s/, @body_lines;
334                 $reporter =~ s/^\s+ReportedBy:\s//;
335                 $bug_info{'who'} = $reporter;
336         }
337     }
338     elsif (!$bug_info{'who'}) {
339            if ( my ($changer_line) = grep /^\S+\schanged:$/, @body_lines) {
340                $changer_line =~ /^(\S+)\s/;
341                $bug_info{'who'} = $1;
342            }
343            elsif ( my ($comment_line) = 
344                        grep /^-+.*Comment.*From /i, @body_lines )
345            {
346                $comment_line =~ /^-+.*Comment.*From (\S+) /i;
347                $bug_info{'who'} = $1;
348            }
349     }
350
351     unless ($bug_info{'who'}) {
352         debug_print("Could not determine who made the change.");
353         return undef;
354     }
355     debug_print("Who = $bug_info{who}");
356
357     # Attachment
358     my $attachid;
359     if (($attachid) = grep /^Created an attachment \(id=\d+\)/, @body_lines) {
360         $attachid =~ /^Created an attachment \(id=(\d+)\)/;
361         $bug_info{'attach_id'} = $1;
362         debug_print("attach_id: $bug_info{attach_id}");
363     }
364
365     # Duplicate
366     my $dupid;
367     if (($dupid) = grep /marked as a duplicate of (?:bug\s)?\d+/, @body_lines) {
368         $dupid =~ /marked as a duplicate of (?:bug\s)?(\d+)/;
369         $bug_info{'dup_of'} = $1;
370         debug_print("Got dup_of: $bug_info{dup_of}");
371     }
372
373     # Figure out where the diff table ends, and where comments start.
374     my $comments_start_at = 0;
375     foreach my $check_line (@body_lines) {
376         last if $check_line =~ /^-+.*Comment.*From /i;
377         $comments_start_at++;
378     }
379     
380     debug_print("Comments start at line $comments_start_at.");
381     my @diff_lines = @body_lines[0 .. ($comments_start_at - 1)];
382     my %diffs = parse_diffs(\@diff_lines);
383     $bug_info{'diffs'} = \%diffs;
384
385     return \%bug_info;
386 }
387
388 # Takes the %bug_info hash returned from parse_mail and
389 # makes it into one or more lines for the bugmail log.
390 # BugMail Log Lines have the following format:
391 # ID::::Product::::Component::::Who::::FieldName::::OldValue::::NewValue::::message
392 # OldValue and NewValue can be empty.
393 # FieldName will be 'NewBug' for new bugs, and 'NewAttach' for new attachments.
394 # Each line ends with a newline, except the last one.
395 sub generate_log ($) {
396     my ($bug_info) = @_;
397
398     my $prefix = $bug_info->{'bug_id'} . FIELD_SEPARATOR 
399                  . $bug_info->{'product'} . FIELD_SEPARATOR
400                  . $bug_info->{'component'} . FIELD_SEPARATOR
401                  . $bug_info->{'who'} . FIELD_SEPARATOR;
402
403     my @lines;
404
405     # New bugs are easy to handle, so let's handle them first.
406     if ($bug_info->{'new'}) {
407         push(@lines, $prefix . 'NewBug' . FIELD_SEPARATOR 
408             # Old and New are empty.
409             . FIELD_SEPARATOR . FIELD_SEPARATOR
410             . "New $bug_info->{product} bug $bug_info->{bug_id}"
411             . " filed by $bug_info->{who}.");
412     }
413
414     if ($bug_info->{'attach_id'}) {
415         push(@lines, $prefix . 'NewAttach' . FIELD_SEPARATOR
416             # Old and New are empty.
417             . FIELD_SEPARATOR . FIELD_SEPARATOR
418             . "$bug_info->{'who'} added attachment $bug_info->{'attach_id'}"
419             . " to bug $bug_info->{'bug_id'}.");
420     }
421
422     # And now we handle changes by going over all the diffs, one by one.
423     my %diffs = %{$bug_info->{'diffs'}};
424     foreach my $id (sort(keys %diffs)) {
425         my $field = $diffs{$id}[0];
426         my $old = $diffs{$id}[1];
427         my $new = $diffs{$id}[2];
428
429         # For attachments, we don't want to include the bug number in
430         # the output.
431         $field =~ s/^(Attachment)( .)(\d+)/$1/;
432         my $attach_id = $3;
433
434         # Flags get a *very* special handling.
435         if ($field =~ /Flag$/) {
436             my %flags = parse_flags($new, $old);
437             foreach my $flag (keys %flags) {
438                 my ($old_flag, $new_flag) = @{$flags{$flag}};
439                 my $line = $prefix . $field . FIELD_SEPARATOR
440                            . $old_flag . FIELD_SEPARATOR
441                            . $new_flag . FIELD_SEPARATOR
442                            . $bug_info->{'who'};
443                 $line .= flag_action($new_flag, $old_flag);
444                 if ($field =~ /^Attachment/) {
445                     $line .= " for attachment $attach_id";
446                 }
447                 $line .= " on bug $bug_info->{bug_id}.";
448                 push(@lines, $line);
449             }
450         }
451
452         # All other, non-Flag fields.
453         else {
454             my $line = $prefix . $field . FIELD_SEPARATOR 
455                        . $old . FIELD_SEPARATOR . $new . FIELD_SEPARATOR 
456                        . $bug_info->{who};
457             # Some fields require the verbs "added" and "removed", like the 
458             # CC field.
459             if (MULTI_FIELDS->{$field}) {
460                 ($line .= " added $new to") if $new;
461                 ($line .= " and") if $new && $old;
462                 ($line .= " removed $old from") if $old;
463                 $line .= " the $field field on bug $bug_info->{bug_id}.";
464             }
465             # If we didn't remove anything, only added something.
466             elsif (!$old) {
467                 $line .= " set the $field field on bug"
468                          . " $bug_info->{bug_id} to $new";
469                 # Hack for "RESOLVED DUPLICATE" messages.
470                 $line .= ' of bug ' . $bug_info->{dup_of} if exists $bug_info->{dup_of};
471                 $line .= '.';
472             }
473             # If we didn't add anything, only removed something.
474             elsif (!$new) {
475                 $line .= " cleared the $field '$old' from bug"
476                          . " $bug_info->{bug_id}.";
477             }
478             # If we changed a field from one value to another.
479             else {
480                 $line .= " changed the $field on bug" 
481                          . " $bug_info->{bug_id} from $old to $new.";
482             }
483             push(@lines, $line);
484         }
485     }
486
487     debug_print("Generated Log Lines.");
488     debug_print("Log Line: $_") foreach (@lines);
489     
490     return join("\n", @lines);
491 }
492
493 # Takes a string and appends it to the buglog.
494 sub append_log ($) {
495     my ($string) = @_;
496
497     (open FILE, ">>" . $bug_log)
498         or die "Couldn't open bug log file $bug_log: $!";
499     debug_print("Waiting for a lock on the log...");
500     flock(FILE, LOCK_EX);
501     print FILE $string . "\n";
502     flock(FILE, LOCK_UN);
503     debug_print("Printed lines to log and unlocked file.");
504     close FILE;
505 }
506
507
508 #####################################################################
509 # Main Script
510 #####################################################################
511
512 debug_print("\n\n");
513
514 unless (-e $bug_log) {
515     print STDERR "$bug_log does not exist, so I assume that mozbot is not"
516                  . " running. Discarding incoming message.\n";
517     exit;
518 }
519
520 my @mail_array = <STDIN>;
521 my $bug_info = parse_mail(\@mail_array);
522
523 if (defined $bug_info) {
524     my $log_lines = generate_log($bug_info);
525     # If we got an email with just a comment, $log_lines will be empty.
526     append_log($log_lines) if $log_lines;
527 }
528
529 debug_print("All done!");
530 exit;