Debbugs/Control.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later
   3 # version at your option.
   4 # See the file README and COPYING for more information.
   5 #
   6 # [Other people have contributed to this file; their copyrights should
   7 # go here too.]
   8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   9
  10 package Debbugs::Control;
  11
  12 =head1 NAME
  13
  14 Debbugs::Control -- Routines for modifying the state of bugs
  15
  16 =head1 SYNOPSIS
  17
  18 use Debbugs::Control;
  19
  20
  21 =head1 DESCRIPTION
  22
  23 This module is an abstraction of a lot of functions which originally
  24 were only present in service.in, but as time has gone on needed to be
  25 called from elsewhere.
  26
  27 All of the public functions take the following options:
  28
  29 =over
  30
  31 =item debug -- scalar reference to which debbuging information is
  32 appended
  33
  34 =item transcript -- scalar reference to which transcript information
  35 is appended
  36
  37 =item affected_bugs -- hashref which is updated with bugs affected by
  38 this function
  39
  40
  41 =back
  42
  43 Functions which should (probably) append to the .log file take the
  44 following options:
  45
  46 =over
  47
  48 =item requester -- Email address of the individual who requested the change
  49
  50 =item request_addr -- Address to which the request was sent
  51
  52 =item location -- Optional location; currently ignored but may be
  53 supported in the future for updating archived bugs upon archival
  54
  55 =item message -- The original message which caused the action to be taken
  56
  57 =item append_log -- Whether or not to append information to the log.
  58
  59 =back
  60
  61 B<append_log> (for most functions) is a special option. When set to
  62 false, no appending to the log is done at all. When it is not present,
  63 the above information is faked, and appended to the log file. When it
  64 is true, the above options must be present, and their values are used.
  65
  66
  67 =head1 GENERAL FUNCTIONS
  68
  69 =cut
  70
  71 use warnings;
  72 use strict;
  73 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  74 use base qw(Exporter);
  75
  76 BEGIN{
  77      $VERSION = 1.00;
  78      $DEBUG = 0 unless defined $DEBUG;
  79
  80      @EXPORT = ();
  81      %EXPORT_TAGS = (owner   => [qw(owner)],
  82                      archive => [qw(bug_archive bug_unarchive),
  83                                 ],
  84                      log     => [qw(append_action_to_log),
  85                                 ],
  86                     );
  87      @EXPORT_OK = ();
  88      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  89      $EXPORT_TAGS{all} = [@EXPORT_OK];
  90 }
  91
  92 use Debbugs::Config qw(:config);
  93 use Debbugs::Common qw(:lock buglog :misc get_hashname);
  94 use Debbugs::Status qw(bug_archiveable :read :hook writebug);
  95 use Debbugs::CGI qw(html_escape);
  96 use Debbugs::Log qw(:misc);
  97 use Debbugs::Recipients qw(:add);
  98
  99 use Params::Validate qw(validate_with :types);
 100 use File::Path qw(mkpath);
 101 use IO::File;
 102
 103 use Debbugs::Text qw(:templates);
 104
 105 use Debbugs::Mail qw(rfc822_date);
 106
 107 use POSIX qw(strftime);
 108
 109 use Carp;
 110
 111 # These are a set of options which are common to all of these functions
 112
 113 my %common_options = (debug       => {type => SCALARREF|HANDLE,
 114                                       optional => 1,
 115                                      },
 116                       transcript  => {type => SCALARREF|HANDLE,
 117                                       optional => 1,
 118                                      },
 119                       affected_bugs => {type => HASHREF,
 120                                         optional => 1,
 121                                        },
 122                       affected_packages => {type => HASHREF,
 123                                             optional => 1,
 124                                            },
 125                       recipients    => {type => HASHREF,
 126                                         default => {},
 127                                        },
 128                       limit         => {type => HASHREF,
 129                                         default => {},
 130                                        },
 131                      );
 132
 133
 134 my %append_action_options =
 135      (action => {type => SCALAR,
 136                  optional => 1,
 137                 },
 138       requester => {type => SCALAR,
 139                     optional => 1,
 140                    },
 141       request_addr => {type => SCALAR,
 142                        optional => 1,
 143                       },
 144       location => {type => SCALAR,
 145                    optional => 1,
 146                   },
 147       message  => {type => SCALAR|ARRAYREF,
 148                    optional => 1,
 149                   },
 150       append_log => {type => BOOLEAN,
 151                      optional => 1,
 152                      depends => [qw(requester request_addr),
 153                                  qw(message),
 154                                 ],
 155                     },
 156      );
 157
 158
 159 # this is just a generic stub for Debbugs::Control functions.
 160 # sub foo {
 161 #     my %param = validate_with(params => \@_,
 162 #                             spec   => {bug => {type   => SCALAR,
 163 #                                                regex  => qr/^\d+$/,
 164 #                                               },
 165 #                                        # specific options here
 166 #                                        %common_options,
 167 #                                        %append_action_options,
 168 #                                       },
 169 #                            );
 170 #     our $locks = 0;
 171 #     $locks = 0;
 172 #     local $SIG{__DIE__} = sub {
 173 #       if ($locks) {
 174 #           for (1..$locks) { unfilelock(); }
 175 #           $locks = 0;
 176 #       }
 177 #     };
 178 #     my ($debug,$transcript) = __handle_debug_transcript(%param);
 179 #     my (@data);
 180 #     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 181 #     __handle_affected_packages(data => \@data,%param);
 182 #     add_recipients(data => \@data,
 183 #                    recipients => $param{recipients}
 184 #                   );
 185 # }
 186
 187 =head1 OWNER FUNCTIONS
 188
 189 =head2 owner
 190
 191      eval {
 192             owner(bug          => $ref,
 193                   transcript   => $transcript,
 194                   ($dl > 0 ? (debug => $transcript):()),
 195                   requester    => $header{from},
 196                   request_addr => $controlrequestaddr,
 197                   message      => \@log,
 198                   recipients   => \%recipients,
 199                   owner        => undef,
 200                  );
 201         };
 202         if ($@) {
 203             $errors++;
 204             print {$transcript} "Failed to mark $ref as having an owner: $@";
 205         }
 206
 207 Handles all setting of the owner field; given an owner of undef or of
 208 no length, indicates that a bug is not owned by anyone.
 209
 210 =cut
 211
 212 sub owner {
 213      my %param = validate_with(params => \@_,
 214                                spec   => {bug => {type   => SCALAR,
 215                                                   regex  => qr/^\d+$/,
 216                                                  },
 217                                           owner => {type => SCALAR|UNDEF,
 218                                                    },
 219                                           %common_options,
 220                                           %append_action_options,
 221                                          },
 222                               );
 223      our $locks = 0;
 224      $locks = 0;
 225      local $SIG{__DIE__} = sub {
 226           if ($locks) {
 227                for (1..$locks) { unfilelock(); }
 228                $locks = 0;
 229           }
 230      };
 231      my ($debug,$transcript) = __handle_debug_transcript(%param);
 232      my (@data);
 233      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 234      __handle_affected_packages(data => \@data,%param);
 235      @data and defined $data[0] or die "No bug found for $param{bug}";
 236      add_recipients(data => \@data,
 237                     recipients => $param{recipients}
 238                    );
 239      my $action = '';
 240      for my $data (@data) {
 241           print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
 242           print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
 243           if (not defined $param{owner} or not length $param{owner}) {
 244                $param{owner} = '';
 245                $action = "Removed annotation that $config{bug} was owned by " .
 246                     "$data->{owner}.";
 247           }
 248           else {
 249                if (length $data->{owner}) {
 250                     $action = "Owner changed from $data->{owner} to $param{owner}.";
 251                }
 252                else {
 253                     $action = "Owner recorded as $param{owner}."
 254                }
 255           }
 256           $data->{owner} = $param{owner};
 257           append_action_to_log(bug => $data->{bug_num},
 258                                get_lock => 0,
 259                __return_append_to_log_options(
 260                                               %param,
 261                                               action => $action,
 262                                              ),
 263                               )
 264                if not exists $param{append_log} or $param{append_log};
 265           writebug($data->{bug_num},$data);
 266           print {$transcript} "$action\n";
 267           add_recipients(data => $data,
 268                          recipients => $param{recipients},
 269                         );
 270      }
 271      if ($locks) {
 272           for (1..$locks) { unfilelock(); }
 273      }
 274 }
 275
 276
 277 =head1 ARCHIVE FUNCTIONS
 278
 279
 280 =head2 bug_archive
 281
 282      my $error = '';
 283      eval {
 284         bug_archive(bug => $bug_num,
 285                     debug => \$debug,
 286                     transcript => \$transcript,
 287                    );
 288      };
 289      if ($@) {
 290         $errors++;
 291         transcript("Unable to archive $bug_num\n");
 292         warn $@;
 293      }
 294      transcript($transcript);
 295
 296
 297 This routine archives a bug
 298
 299 =over
 300
 301 =item bug -- bug number
 302
 303 =item check_archiveable -- check wether a bug is archiveable before
 304 archiving; defaults to 1
 305
 306 =item archive_unarchived -- whether to archive bugs which have not
 307 previously been archived; defaults to 1. [Set to 0 when used from
 308 control@]
 309
 310 =item ignore_time -- whether to ignore time constraints when archiving
 311 a bug; defaults to 0.
 312
 313 =back
 314
 315 =cut
 316
 317 sub bug_archive {
 318      my %param = validate_with(params => \@_,
 319                                spec   => {bug => {type   => SCALAR,
 320                                                   regex  => qr/^\d+$/,
 321                                                  },
 322                                           check_archiveable => {type => BOOLEAN,
 323                                                                 default => 1,
 324                                                                },
 325                                           archive_unarchived => {type => BOOLEAN,
 326                                                                  default => 1,
 327                                                                 },
 328                                           ignore_time => {type => BOOLEAN,
 329                                                           default => 0,
 330                                                          },
 331                                           %common_options,
 332                                           %append_action_options,
 333                                          },
 334                               );
 335      our $locks = 0;
 336      $locks = 0;
 337      local $SIG{__DIE__} = sub {
 338           if ($locks) {
 339                for (1..$locks) { unfilelock(); }
 340                $locks = 0;
 341           }
 342      };
 343      my $action = "$config{bug} archived.";
 344      my ($debug,$transcript) = __handle_debug_transcript(%param);
 345      if ($param{check_archiveable} and
 346          not bug_archiveable(bug=>$param{bug},
 347                              ignore_time => $param{ignore_time},
 348                             )) {
 349           print {$transcript} "Bug $param{bug} cannot be archived\n";
 350           die "Bug $param{bug} cannot be archived";
 351      }
 352      print {$debug} "$param{bug} considering\n";
 353      my (@data);
 354      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 355      __handle_affected_packages(data => \@data,%param);
 356      print {$debug} "$param{bug} read $locks\n";
 357      @data and defined $data[0] or die "No bug found for $param{bug}";
 358      print {$debug} "$param{bug} read done\n";
 359
 360      if (not $param{archive_unarchived} and
 361          not exists $data[0]{unarchived}
 362         ) {
 363           print {$transcript} "$param{bug} has not been archived previously\n";
 364           die "$param{bug} has not been archived previously";
 365      }
 366      add_recipients(recipients => $param{recipients},
 367                     data => \@data,
 368                    );
 369      my @bugs = map {$_->{bug_num}} @data;
 370      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 371      for my $bug (@bugs) {
 372          if ($param{check_archiveable}) {
 373              die "Bug $bug cannot be archived (but $param{bug} can?)"
 374                  unless bug_archiveable(bug=>$bug,
 375                                         ignore_time => $param{ignore_time},
 376                                        );
 377          }
 378      }
 379      # If we get here, we can archive/remove this bug
 380      print {$debug} "$param{bug} removing\n";
 381      for my $bug (@bugs) {
 382           #print "$param{bug} removing $bug\n" if $debug;
 383           my $dir = get_hashname($bug);
 384           # First indicate that this bug is being archived
 385           append_action_to_log(bug => $bug,
 386                                get_lock => 0,
 387                                __return_append_to_log_options(
 388                                  %param,
 389                                  action => $action,
 390                                 )
 391                               )
 392                if not exists $param{append_log} or $param{append_log};
 393           my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
 394           if ($config{save_old_bugs}) {
 395                mkpath("$config{spool_dir}/archive/$dir");
 396                foreach my $file (@files_to_remove) {
 397                     link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
 398                          copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
 399                }
 400
 401                print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
 402           }
 403           unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
 404           print {$transcript} "deleted $bug (from $param{bug})\n";
 405      }
 406      bughook_archive(@bugs);
 407      if (exists $param{bugs_affected}) {
 408           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 409      }
 410      print {$debug} "$param{bug} unlocking $locks\n";
 411      if ($locks) {
 412           for (1..$locks) { unfilelock(); }
 413      }
 414      print {$debug} "$param{bug} unlocking done\n";
 415 }
 416
 417 =head2 bug_unarchive
 418
 419      my $error = '';
 420      eval {
 421         bug_unarchive(bug => $bug_num,
 422                       debug => \$debug,
 423                       transcript => \$transcript,
 424                      );
 425      };
 426      if ($@) {
 427         $errors++;
 428         transcript("Unable to archive bug: $bug_num");
 429      }
 430      transcript($transcript);
 431
 432 This routine unarchives a bug
 433
 434 =cut
 435
 436 sub bug_unarchive {
 437      my %param = validate_with(params => \@_,
 438                                spec   => {bug => {type   => SCALAR,
 439                                                   regex  => qr/^\d+/,
 440                                                  },
 441                                           %common_options,
 442                                           %append_action_options,
 443                                          },
 444                               );
 445      our $locks = 0;
 446      local $SIG{__DIE__} = sub {
 447           if ($locks) {
 448                for (1..$locks) { unfilelock(); }
 449                $locks = 0;
 450           }
 451      };
 452      my $action = "$config{bug} unarchived.";
 453      my ($debug,$transcript) = __handle_debug_transcript(%param);
 454      print {$debug} "$param{bug} considering\n";
 455      my @data = ();
 456      ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
 457      __handle_affected_packages(data => \@data,%param);
 458      print {$debug} "$param{bug} read $locks\n";
 459      if (not @data or not defined $data[0]) {
 460          print {$transcript} "No bug found for $param{bug}\n";
 461          die "No bug found for $param{bug}";
 462      }
 463      print {$debug} "$param{bug} read done\n";
 464      my @bugs = map {$_->{bug_num}} @data;
 465      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 466      print {$debug} "$param{bug} unarchiving\n";
 467      my @files_to_remove;
 468      for my $bug (@bugs) {
 469           print {$debug} "$param{bug} removing $bug\n";
 470           my $dir = get_hashname($bug);
 471           my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
 472           mkpath("archive/$dir");
 473           foreach my $file (@files_to_copy) {
 474                # die'ing here sucks
 475                link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 476                     copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 477                          die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
 478           }
 479           push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
 480           print {$transcript} "Unarchived $config{bug} $bug\n";
 481      }
 482      unlink(@files_to_remove) or die "Unable to unlink bugs";
 483      # Indicate that this bug has been archived previously
 484      for my $bug (@bugs) {
 485           my $newdata = readbug($bug);
 486           if (not defined $newdata) {
 487                print {$transcript} "$config{bug} $bug disappeared!\n";
 488                die "Bug $bug disappeared!";
 489           }
 490           $newdata->{unarchived} = time;
 491           append_action_to_log(bug => $bug,
 492                                get_lock => 0,
 493                                __return_append_to_log_options(
 494                                  %param,
 495                                  action => $action,
 496                                 )
 497                               )
 498                if not exists $param{append_log} or $param{append_log};
 499           writebug($bug,$newdata);
 500           add_recipients(recipients => $param{recipients},
 501                          data       => $newdata,
 502                         );
 503      }
 504      print {$debug} "$param{bug} unlocking $locks\n";
 505      if ($locks) {
 506           for (1..$locks) { unfilelock(); };
 507      }
 508      if (exists $param{bugs_affected}) {
 509           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 510      }
 511      print {$debug} "$param{bug} unlocking done\n";
 512 }
 513
 514 =head2 append_action_to_log
 515
 516      append_action_to_log
 517
 518 This should probably be moved to Debbugs::Log; have to think that out
 519 some more.
 520
 521 =cut
 522
 523 sub append_action_to_log{
 524      my %param = validate_with(params => \@_,
 525                                spec   => {bug => {type   => SCALAR,
 526                                                   regex  => qr/^\d+/,
 527                                                  },
 528                                           action => {type => SCALAR,
 529                                                     },
 530                                           requester => {type => SCALAR,
 531                                                        },
 532                                           request_addr => {type => SCALAR,
 533                                                           },
 534                                           location => {type => SCALAR,
 535                                                        optional => 1,
 536                                                       },
 537                                           message  => {type => SCALAR|ARRAYREF,
 538                                                       },
 539                                           get_lock   => {type => BOOLEAN,
 540                                                          default => 1,
 541                                                         },
 542                                          }
 543                               );
 544      # Fix this to use $param{location}
 545      my $log_location = buglog($param{bug});
 546      die "Unable to find .log for $param{bug}"
 547           if not defined $log_location;
 548      if ($param{get_lock}) {
 549           filelock("lock/$param{bug}");
 550      }
 551      my $log = IO::File->new(">>$log_location") or
 552           die "Unable to open $log_location for appending: $!";
 553      print {$log} "\6\n".
 554           "<!-- time:".time." -->\n".
 555           "<strong>".html_escape($param{action})."</strong>\n".
 556           "Request was from <code>".html_escape($param{requester})."</code>\n".
 557           "to <code>".html_escape($param{request_addr})."</code>. \n".
 558           "\3\n".
 559           "\7\n",escape_log(make_list($param{message})),"\n\3\n"
 560                or die "Unable to append to $log_location: $!";
 561      close $log or die "Unable to close $log_location: $!";
 562      if ($param{get_lock}) {
 563           unlockfile();
 564      }
 565
 566
 567 }
 568
 569
 570 =head1 PRIVATE FUNCTIONS
 571
 572 =head2 __handle_affected_packages
 573
 574      __handle_affected_packages(affected_packages => {},
 575                                 data => [@data],
 576                                )
 577
 578
 579
 580 =cut
 581
 582 sub __handle_affected_packages{
 583      my %param = validate_with(params => \@_,
 584                                spec   => {%common_options,
 585                                           data => {type => ARRAYREF|HASHREF
 586                                                   },
 587                                          },
 588                                allow_extra => 1,
 589                               );
 590      for my $data (make_list($param{data})) {
 591           $param{affected_packages}{$data->{package}} = 1;
 592      }
 593 }
 594
 595 =head2 __handle_debug_transcript
 596
 597      my ($debug,$transcript) = __handle_debug_transcript(%param);
 598
 599 Returns a debug and transcript filehandle
 600
 601
 602 =cut
 603
 604 sub __handle_debug_transcript{
 605      my %param = validate_with(params => \@_,
 606                                spec   => {%common_options},
 607                                allow_extra => 1,
 608                               );
 609      my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
 610      my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
 611      return ($debug,$transcript);
 612 }
 613
 614 sub __return_append_to_log_options{
 615      my %param = @_;
 616      my $action = $param{action} if exists $param{action};
 617      if (not exists $param{requester}) {
 618           $param{requester} = $config{control_internal_requester};
 619      }
 620      if (not exists $param{request_addr}) {
 621           $param{request_addr} = $config{control_internal_request_addr};
 622      }
 623      if (not exists $param{message}) {
 624           my $date = rfc822_date();
 625           $param{message} = fill_in_template(template  => 'mail/fake_control_message',
 626                                              variables => {request_addr => $param{request_addr},
 627                                                            requester    => $param{requester},
 628                                                            date         => $date,
 629                                                            action       => $action
 630                                                           },
 631                                             );
 632      }
 633      if (not defined $action) {
 634           carp "Undefined action!";
 635           $action = "unknown action";
 636      }
 637      return (action => $action,
 638              (map {exists $append_action_options{$_}?($_,$param{$_}):()}
 639               keys %param),
 640             );
 641 }
 642
 643
 644 1;
 645
 646 __END__