Debbugs/Recipients.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later version. See the
   3 # file README and COPYING for more information.
   4 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   5 # $Id: perl_module_header.pm 1221 2008-05-19 15:00:40Z don $
   6
   7 package Debbugs::Recipients;
   8
   9 =head1 NAME
  10
  11 Debbugs::Recipients -- Determine recipients of messages from the bts
  12
  13 =head1 SYNOPSIS
  14
  15
  16 =head1 DESCRIPTION
  17
  18
  19 =head1 BUGS
  20
  21 None known.
  22
  23 =cut
  24
  25 use warnings;
  26 use strict;
  27 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  28 use Exporter qw(import);
  29
  30 BEGIN{
  31      ($VERSION) = q$Revision: 1221 $ =~ /^Revision:\s+([^\s+])/;
  32      $DEBUG = 0 unless defined $DEBUG;
  33
  34      @EXPORT = ();
  35      %EXPORT_TAGS = (add    => [qw(add_recipients)],
  36                      det    => [qw(determine_recipients)],
  37                     );
  38      @EXPORT_OK = ();
  39      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  40      $EXPORT_TAGS{all} = [@EXPORT_OK];
  41
  42 }
  43
  44 use Debbugs::Config qw(:config);
  45 use Params::Validate qw(:types validate_with);
  46 use Debbugs::Common qw(:misc :util);
  47 use Debbugs::Status qw(splitpackages isstrongseverity);
  48
  49 use Debbugs::Packages qw(binary_to_source);
  50
  51 use Debbugs::Mail qw(get_addresses);
  52
  53 use Carp;
  54
  55 =head2 add_recipients
  56
  57      add_recipients(data => $data,
  58                     recipients => \%recipients;
  59                    );
  60
  61 Given data (from read_bug or similar) (or an arrayref of data),
  62 calculates the addresses which need to receive mail involving this
  63 bug.
  64
  65 =over
  66
  67 =item data -- Data from read_bug or similar; can be an arrayref of data
  68
  69 =item recipients -- hashref of recipient data structure; pass to
  70 subsequent calls of add_recipients or
  71
  72 =item debug -- optional
  73
  74
  75 =back
  76
  77 =cut
  78
  79
  80 sub add_recipients {
  81      # Data structure is:
  82      #   maintainer email address &c -> assoc of packages -> assoc of bug#'s
  83      my %param = validate_with(params => \@_,
  84                                spec   => {data => {type => HASHREF|ARRAYREF,
  85                                                   },
  86                                           recipients => {type => HASHREF,
  87                                                         },
  88                                           debug => {type => HANDLE|SCALARREF,
  89                                                     optional => 1,
  90                                                    },
  91                                           transcript => {type => HANDLE|SCALARREF,
  92                                                          optional => 1,
  93                                                         },
  94                                           actions_taken => {type => HASHREF,
  95                                                             default => {},
  96                                                            },
  97                                           unknown_packages => {type => HASHREF,
  98                                                                default => {},
  99                                                               },
 100                                          },
 101                               );
 102
 103      $param{transcript} = globify_scalar($param{transcript});
 104      $param{debug} = globify_scalar($param{debug});
 105      if (ref ($param{data}) eq 'ARRAY') {
 106           for my $data (@{$param{data}}) {
 107                add_recipients(data => $data,
 108                               map {exists $param{$_}?($_,$param{$_}):()}
 109                               qw(recipients debug transcript actions_taken unknown_packages)
 110                              );
 111           }
 112           return;
 113      }
 114      my ($addmaint);
 115      my $ref = $param{data}{bug_num};
 116      for my $p (splitpackages($param{data}{package})) {
 117           $p = lc($p);
 118           if (defined $config{subscription_domain}) {
 119                my @source_packages = binary_to_source(binary => $p,
 120                                                       source_only => 1,
 121                                                      );
 122                if (@source_packages) {
 123                     for my $source (@source_packages) {
 124                          _add_address(recipients => $param{recipients},
 125                                       address => "$source\@".$config{subscription_domain},
 126                                       reason => $source,
 127                                       type  => 'bcc',
 128                                      );
 129                     }
 130                }
 131                else {
 132                     _add_address(recipients => $param{recipients},
 133                                  address => "$p\@".$config{subscription_domain},
 134                                  reason => $p,
 135                                  type  => 'bcc',
 136                                 );
 137                }
 138           }
 139           if (defined $param{data}{severity} and defined $config{strong_list} and
 140               isstrongseverity($param{data}{severity})) {
 141                _add_address(recipients => $param{recipients},
 142                             address => "$config{strong_list}\@".$config{list_domain},
 143                             reason => $param{data}{severity},
 144                             type  => 'bcc',
 145                            );
 146           }
 147           my @maints = package_maintainer(binary => $p);
 148           if (@maints) {
 149               print {$param{debug}} "MR|".join(',',@maints)."|$p|$ref|\n";
 150               _add_address(recipients => $param{recipients},
 151                            address => \@maints,
 152                            reason => $p,
 153                            bug_num => $param{data}{bug_num},
 154                            type  => 'cc',
 155                           );
 156               print {$param{debug}} "maintainer add >$p|".join(',',@maints)."<\n";
 157           }
 158           else {
 159                print {$param{debug}} "maintainer none >$p<\n";
 160                if (not exists $param{unknown_packages}{$p}) {
 161                    print {$param{transcript}} "Warning: Unknown package '$p'\n";
 162                    $param{unknown_packages}{$p} = 1;
 163                }
 164                print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
 165                _add_address(recipients => $param{recipients},
 166                             address => $config{unknown_maintainer_email},
 167                             reason => $p,
 168                             bug_num => $param{data}{bug_num},
 169                             type  => 'cc',
 170                            )
 171                     if defined $config{unknown_maintainer_email} and
 172                          length $config{unknown_maintainer_email};
 173           }
 174       }
 175      if (defined $config{bug_subscription_domain} and
 176          length $config{bug_subscription_domain}) {
 177           _add_address(recipients => $param{recipients},
 178                        address    => 'bugs='.$param{data}{bug_num}.'@'.
 179                                      $config{bug_subscription_domain},
 180                        reason     => "bug $param{data}{bug_num}",
 181                        bug_num    => $param{data}{bug_num},
 182                        type       => 'bcc',
 183                       );
 184       }
 185      if (defined $config{cc_all_mails_to_addr} and
 186          length $config{cc_all_mails_to_addr}
 187         ) {
 188          _add_address(recipients => $param{recipients},
 189                       address    => $config{cc_all_mails_to},
 190                       reason     => "cc_all_mails_to",
 191                       bug_num    => $param{data}{bug_num},
 192                       type       => 'bcc',
 193                      );
 194      }
 195
 196      if (length $param{data}{owner}) {
 197           $addmaint = $param{data}{owner};
 198           print {$param{debug}} "MO|$addmaint|$param{data}{package}|$ref|\n";
 199           _add_address(recipients => $param{recipients},
 200                        address => $addmaint,
 201                        reason => "owner of $param{data}{bug_num}",
 202                        bug_num => $param{data}{bug_num},
 203                        type  => 'cc',
 204                       );
 205         print {$param{debug}} "owner add >$param{data}{package}|$addmaint<\n";
 206      }
 207      if (exists $param{actions_taken}) {
 208           if (exists $param{actions_taken}{done} and
 209               $param{actions_taken}{done} and
 210               length($config{done_list}) and
 211               length($config{list_domain})
 212              ) {
 213                _add_address(recipients => $param{recipients},
 214                             type       => 'cc',
 215                             address    => $config{done_list}.'@'.$config{list_domain},
 216                             bug_num    => $param{data}{bug_num},
 217                             reason     => "bug $param{data}{bug_num} done",
 218                            );
 219           }
 220           if (exists $param{actions_taken}{forwarded} and
 221               $param{actions_taken}{forwarded} and
 222               length($config{forward_list}) and
 223               length($config{list_domain})
 224              ) {
 225                _add_address(recipients => $param{recipients},
 226                             type       => 'cc',
 227                             address    => $config{forward_list}.'@'.$config{list_domain},
 228                             bug_num    => $param{data}{bug_num},
 229                             reason     => "bug $param{data}{bug_num} forwarded",
 230                            );
 231           }
 232      }
 233 }
 234
 235 =head2 determine_recipients
 236
 237      my @recipients = determine_recipients(recipients => \%recipients,
 238                                            bcc => 1,
 239                                           );
 240      my %recipients => determine_recipients(recipients => \%recipients,);
 241
 242      # or a crazy example:
 243      send_mail_message(message => $message,
 244                        recipients =>
 245                         [make_list(
 246                           values %{{determine_recipients(
 247                                 recipients => \%recipients)
 248                                   }})
 249                         ],
 250                       );
 251
 252 Using the recipient hashref, determines the set of recipients.
 253
 254 If you specify one of C<bcc>, C<cc>, or C<to>, you will receive only a
 255 LIST of recipients which the main should be Bcc'ed, Cc'ed, or To'ed
 256 respectively. By default, a LIST with keys bcc, cc, and to is returned
 257 with ARRAYREF values corresponding to the users to whom a message
 258 should be sent.
 259
 260 =over
 261
 262 =item address_only -- whether to only return mail addresses without reasons or realnamesq
 263
 264 =back
 265
 266 Passing more than one of bcc, cc or to is a fatal error.
 267
 268 =cut
 269
 270 sub determine_recipients {
 271      my %param = validate_with(params => \@_,
 272                                spec   => {recipients => {type => HASHREF,
 273                                                         },
 274                                           bcc        => {type => BOOLEAN,
 275                                                          default => 0,
 276                                                         },
 277                                           cc         => {type => BOOLEAN,
 278                                                          default => 0,
 279                                                         },
 280                                           to         => {type => BOOLEAN,
 281                                                          default => 0,
 282                                                         },
 283                                           address_only => {type => BOOLEAN,
 284                                                            default => 0,
 285                                                           }
 286                                          },
 287                               );
 288
 289      if (1 < scalar grep {$param{$_}} qw(to cc bcc)) {
 290           croak "Passing more than one of to, cc, or bcc is non-sensical";
 291      }
 292
 293      my %final_recipients;
 294      # start with the to recipients
 295      for my $addr (keys %{$param{recipients}}) {
 296           my $level = 'bcc';
 297           my @reasons;
 298           for my $reason (keys %{$param{recipients}{$addr}}) {
 299                my @bugs;
 300                for my $bug (keys %{$param{recipients}{$addr}{$reason}}) {
 301                     push @bugs, $bug;
 302                     my $t_level = $param{recipients}{$addr}{$reason}{$bug};
 303                     if ($level eq 'to' or
 304                         $t_level eq 'to') {
 305                          $level = 'to';
 306                     }
 307                     elsif ($t_level eq 'cc') {
 308                          $level = 'cc';
 309                     }
 310                }
 311                # RFC 2822 comments cannot contain specials and
 312                # unquoted () or \; there's no reason for us to allow
 313                # insane things here, though, so we restrict this even
 314                # more to 20-7E ( -~)
 315                $reason =~ s/\\/\\\\/g;
 316                $reason =~ s/([\)\(])/\\$1/g;
 317                $reason =~ s/[^\x20-\x7E]//g;
 318                push @reasons, $reason . ' for {'.join(',',@bugs).'}';
 319           }
 320           if ($param{address_only}) {
 321                push @{$final_recipients{$level}}, get_addresses($addr);
 322           }
 323           else {
 324                push @{$final_recipients{$level}}, $addr . ' ('.join(', ',@reasons).')';
 325           }
 326      }
 327      for (qw(to cc bcc)) {
 328           if ($param{$_}) {
 329                if (exists $final_recipients{$_}) {
 330                     return @{$final_recipients{$_}||[]};
 331                }
 332                return ();
 333           }
 334      }
 335      return %final_recipients;
 336 }
 337
 338
 339 =head1 PRIVATE FUNCTIONS
 340
 341 =head2 _add_address
 342
 343           _add_address(recipients => $param{recipients},
 344                        address => $addmaint,
 345                        reason => $param{data}{package},
 346                        bug_num => $param{data}{bug_num},
 347                        type  => 'cc',
 348                       );
 349
 350
 351 =cut
 352
 353
 354 sub _add_address {
 355      my %param = validate_with(params => \@_,
 356                                spec => {recipients => {type => HASHREF,
 357                                                       },
 358                                         bug_num    => {type => SCALAR,
 359                                                        regex => qr/^\d*$/,
 360                                                        default => '',
 361                                                       },
 362                                         reason     => {type => SCALAR,
 363                                                        default => '',
 364                                                       },
 365                                         address    => {type => SCALAR|ARRAYREF,
 366                                                       },
 367                                         type       => {type => SCALAR,
 368                                                        default => 'cc',
 369                                                        regex   => qr/^(?:b?cc|to)$/i,
 370                                                       },
 371                                        },
 372                               );
 373      for my $addr (make_list($param{address})) {
 374           if (lc($param{type}) eq 'bcc' and
 375               exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
 376              ) {
 377                next;
 378           }
 379           elsif (lc($param{type}) eq 'cc' and
 380                  exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
 381                  and $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} eq 'to'
 382                 ) {
 383                next;
 384           }
 385           $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = lc($param{type});
 386      }
 387 }
 388
 389 1;
 390
 391
 392 __END__
 393
 394
 395
 396
 397
 398