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;