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 = (archive => [qw(bug_archive bug_unarchive),
  82                                 ],
  83                      log     => [qw(append_action_to_log),
  84                                 ],
  85                     );
  86      @EXPORT_OK = ();
  87      Exporter::export_ok_tags(qw(archive log));
  88      $EXPORT_TAGS{all} = [@EXPORT_OK];
  89 }
  90
  91 use Debbugs::Config qw(:config);
  92 use Debbugs::Common qw(:lock buglog :misc get_hashname);
  93 use Debbugs::Status qw(bug_archiveable :read :hook writebug);
  94 use Debbugs::CGI qw(html_escape);
  95 use Debbugs::Log qw(:misc);
  96 use Debbugs::Recipients qw(:add);
  97
  98 use Params::Validate qw(validate_with :types);
  99 use File::Path qw(mkpath);
 100 use IO::File;
 101
 102 use Debbugs::Text qw(:templates);
 103
 104 use Debbugs::Mail qw(rfc822_date);
 105
 106 use POSIX qw(strftime);
 107
 108 use Carp;
 109
 110 # These are a set of options which are common to all of these functions
 111
 112 my %common_options = (debug       => {type => SCALARREF|HANDLE,
 113                                       optional => 1,
 114                                      },
 115                       transcript  => {type => SCALARREF|HANDLE,
 116                                       optional => 1,
 117                                      },
 118                       affected_bugs => {type => HASHREF,
 119                                         optional => 1,
 120                                        },
 121                       recipients    => {type => HASHREF,
 122                                         default => {},
 123                                        },
 124                       limit         => {type => HASHREF,
 125                                         default => {},
 126                                        },
 127                      );
 128
 129
 130 my %append_action_options =
 131      (action => {type => SCALAR,
 132                  optional => 1,
 133                 },
 134       requester => {type => SCALAR,
 135                     optional => 1,
 136                    },
 137       request_addr => {type => SCALAR,
 138                        optional => 1,
 139                       },
 140       location => {type => SCALAR,
 141                    optional => 1,
 142                   },
 143       message  => {type => SCALAR|ARRAYREF,
 144                    optional => 1,
 145                   },
 146       append_log => {type => BOOLEAN,
 147                      optional => 1,
 148                      depends => [qw(requester request_addr),
 149                                  qw(message),
 150                                 ],
 151                     },
 152      );
 153
 154
 155 # this is just a generic stub for Debbugs::Control functions.
 156 # sub foo {
 157 #     my %param = validate_with(params => \@_,
 158 #                             spec   => {bug => {type   => SCALAR,
 159 #                                                regex  => qr/^\d+$/,
 160 #                                               },
 161 #                                        # specific options here
 162 #                                        %common_options,
 163 #                                        %append_action_options,
 164 #                                       },
 165 #                            );
 166 #     our $locks = 0;
 167 #     $locks = 0;
 168 #     local $SIG{__DIE__} = sub {
 169 #       if ($locks) {
 170 #           for (1..$locks) { unfilelock(); }
 171 #           $locks = 0;
 172 #       }
 173 #     };
 174 #     my ($debug,$transcript) = __handle_debug_transcript(%param);
 175 #     my (@data);
 176 #     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 177 #     add_recipients(data => \@data,
 178 #                    recipients => $param{recipients}
 179 #                   );
 180 # }
 181
 182 =head1 OWNER FUNCTIONS
 183
 184 =head2 owner
 185
 186      eval {
 187             owner(bug          => $ref,
 188                   transcript   => $transcript,
 189                   ($dl > 0 ? (debug => $transcript):()),
 190                   requester    => $header{from},
 191                   request_addr => $controlrequestaddr,
 192                   message      => \@log,
 193                   recipients   => \%recipients,
 194                   owner        => undef,
 195                  );
 196         };
 197         if ($@) {
 198             $errors++;
 199             print {$transcript} "Failed to mark $ref as not having an owner: $@";
 200         }
 201
 202 Handles all setting of the owner field; given an owner of undef or of
 203 no length, indicates that a bug is not owned by anyone.
 204
 205 =cut
 206
 207 sub owner {
 208     my %param = validate_with(params => \@_,
 209                               spec   => {bug => {type   => SCALAR,
 210                                                  regex  => qr/^\d+$/,
 211                                                 },
 212                                          owner => {type => SCALAR|UNDEF,
 213                                                   },
 214                                          %common_options,
 215                                          %append_action_options,
 216                                         },
 217                              );
 218     our $locks = 0;
 219     $locks = 0;
 220     local $SIG{__DIE__} = sub {
 221         if ($locks) {
 222             for (1..$locks) { unfilelock(); }
 223             $locks = 0;
 224         }
 225     };
 226     my ($debug,$transcript) = __handle_debug_transcript(%param);
 227     my (@data);
 228     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 229     @data and defined $data[0] or die "No bug found for $param{bug}";
 230     add_recipients(data => \@data,
 231                    recipients => $param{recipients}
 232                   );
 233     my $action = '';
 234     for my $data (@data) {
 235         if (not defined $param{owner} or not length $param{owner}) {
 236             $param{owner} = '';
 237             $action = "Removed annotation that $gBug was owned by " .
 238                 "$data->{owner}.";
 239         }
 240         else {
 241             if (length $data->{owner}) {
 242                 $action = "Owner changed from $data->{owner} to $param{owner}.";
 243             }
 244             else {
 245                 $action = "Owner recorded as $param{owner}."
 246             }
 247         }
 248         $data->{owner} = $param{owner};
 249         append_action_to_log(bug => $data->{bug_num},
 250                              get_lock => 0,
 251                              __return_append_to_log_options(
 252                                  %param,
 253                                  action => $action,
 254                                 ),
 255                             )
 256             if not exists $param{append_log} or $param{append_log};
 257     }
 258     if ($locks) {
 259         for (1..$locks) { unfilelock(); }
 260     }
 261 }
 262
 263
 264 =head1 ARCHIVE FUNCTIONS
 265
 266
 267 =head2 bug_archive
 268
 269      my $error = '';
 270      eval {
 271         bug_archive(bug => $bug_num,
 272                     debug => \$debug,
 273                     transcript => \$transcript,
 274                    );
 275      };
 276      if ($@) {
 277         $errors++;
 278         transcript("Unable to archive $bug_num\n");
 279         warn $@;
 280      }
 281      transcript($transcript);
 282
 283
 284 This routine archives a bug
 285
 286 =over
 287
 288 =item bug -- bug number
 289
 290 =item check_archiveable -- check wether a bug is archiveable before
 291 archiving; defaults to 1
 292
 293 =item archive_unarchived -- whether to archive bugs which have not
 294 previously been archived; defaults to 1. [Set to 0 when used from
 295 control@]
 296
 297 =item ignore_time -- whether to ignore time constraints when archiving
 298 a bug; defaults to 0.
 299
 300 =back
 301
 302 =cut
 303
 304 sub bug_archive {
 305      my %param = validate_with(params => \@_,
 306                                spec   => {bug => {type   => SCALAR,
 307                                                   regex  => qr/^\d+$/,
 308                                                  },
 309                                           check_archiveable => {type => BOOLEAN,
 310                                                                 default => 1,
 311                                                                },
 312                                           archive_unarchived => {type => BOOLEAN,
 313                                                                  default => 1,
 314                                                                 },
 315                                           ignore_time => {type => BOOLEAN,
 316                                                           default => 0,
 317                                                          },
 318                                           %common_options,
 319                                           %append_action_options,
 320                                          },
 321                               );
 322      our $locks = 0;
 323      $locks = 0;
 324      local $SIG{__DIE__} = sub {
 325           if ($locks) {
 326                for (1..$locks) { unfilelock(); }
 327                $locks = 0;
 328           }
 329      };
 330      my $action = "$config{bug} archived.";
 331      my ($debug,$transcript) = __handle_debug_transcript(%param);
 332      if ($param{check_archiveable} and
 333          not bug_archiveable(bug=>$param{bug},
 334                              ignore_time => $param{ignore_time},
 335                             )) {
 336           print {$transcript} "Bug $param{bug} cannot be archived\n";
 337           die "Bug $param{bug} cannot be archived";
 338      }
 339      print {$debug} "$param{bug} considering\n";
 340      my (@data);
 341      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 342      print {$debug} "$param{bug} read $locks\n";
 343      @data and defined $data[0] or die "No bug found for $param{bug}";
 344      print {$debug} "$param{bug} read done\n";
 345
 346      if (not $param{archive_unarchived} and
 347          not exists $data[0]{unarchived}
 348         ) {
 349           print {$transcript} "$param{bug} has not been archived previously\n";
 350           die "$param{bug} has not been archived previously";
 351      }
 352      add_recipients(recipients => $param{recipients},
 353                     data => \@data,
 354                    );
 355      my @bugs = map {$_->{bug_num}} @data;
 356      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 357      for my $bug (@bugs) {
 358          if ($param{check_archiveable}) {
 359              die "Bug $bug cannot be archived (but $param{bug} can?)"
 360                  unless bug_archiveable(bug=>$bug,
 361                                         ignore_time => $param{ignore_time},
 362                                        );
 363          }
 364      }
 365      # If we get here, we can archive/remove this bug
 366      print {$debug} "$param{bug} removing\n";
 367      for my $bug (@bugs) {
 368           #print "$param{bug} removing $bug\n" if $debug;
 369           my $dir = get_hashname($bug);
 370           # First indicate that this bug is being archived
 371           append_action_to_log(bug => $bug,
 372                                get_lock => 0,
 373                                __return_append_to_log_options(
 374                                  %param,
 375                                  action => $action,
 376                                 )
 377                               )
 378                if not exists $param{append_log} or $param{append_log};
 379           my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
 380           if ($config{save_old_bugs}) {
 381                mkpath("$config{spool_dir}/archive/$dir");
 382                foreach my $file (@files_to_remove) {
 383                     link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
 384                          copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
 385                }
 386
 387                print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
 388           }
 389           unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
 390           print {$transcript} "deleted $bug (from $param{bug})\n";
 391      }
 392      bughook_archive(@bugs);
 393      if (exists $param{bugs_affected}) {
 394           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 395      }
 396      print {$debug} "$param{bug} unlocking $locks\n";
 397      if ($locks) {
 398           for (1..$locks) { unfilelock(); }
 399      }
 400      print {$debug} "$param{bug} unlocking done\n";
 401 }
 402
 403 =head2 bug_unarchive
 404
 405      my $error = '';
 406      eval {
 407         bug_unarchive(bug => $bug_num,
 408                       debug => \$debug,
 409                       transcript => \$transcript,
 410                      );
 411      };
 412      if ($@) {
 413         $errors++;
 414         transcript("Unable to archive bug: $bug_num");
 415      }
 416      transcript($transcript);
 417
 418 This routine unarchives a bug
 419
 420 =cut
 421
 422 sub bug_unarchive {
 423      my %param = validate_with(params => \@_,
 424                                spec   => {bug => {type   => SCALAR,
 425                                                   regex  => qr/^\d+/,
 426                                                  },
 427                                           %common_options,
 428                                           %append_action_options,
 429                                          },
 430                               );
 431      our $locks = 0;
 432      local $SIG{__DIE__} = sub {
 433           if ($locks) {
 434                for (1..$locks) { unfilelock(); }
 435                $locks = 0;
 436           }
 437      };
 438      my $action = "$config{bug} unarchived.";
 439      my ($debug,$transcript) = __handle_debug_transcript(%param);
 440      print {$debug} "$param{bug} considering\n";
 441      my @data = ();
 442      ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
 443      print {$debug} "$param{bug} read $locks\n";
 444      if (not @data or not defined $data[0]) {
 445          print {$transcript} "No bug found for $param{bug}\n";
 446          die "No bug found for $param{bug}";
 447      }
 448      print {$debug} "$param{bug} read done\n";
 449      my @bugs = map {$_->{bug_num}} @data;
 450      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 451      print {$debug} "$param{bug} unarchiving\n";
 452      my @files_to_remove;
 453      for my $bug (@bugs) {
 454           print {$debug} "$param{bug} removing $bug\n";
 455           my $dir = get_hashname($bug);
 456           my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
 457           mkpath("archive/$dir");
 458           foreach my $file (@files_to_copy) {
 459                # die'ing here sucks
 460                link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 461                     copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 462                          die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
 463           }
 464           push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
 465           print {$transcript} "Unarchived $config{bug} $bug\n";
 466      }
 467      unlink(@files_to_remove) or die "Unable to unlink bugs";
 468      # Indicate that this bug has been archived previously
 469      for my $bug (@bugs) {
 470           my $newdata = readbug($bug);
 471           if (not defined $newdata) {
 472                print {$transcript} "$config{bug} $bug disappeared!\n";
 473                die "Bug $bug disappeared!";
 474           }
 475           $newdata->{unarchived} = time;
 476           append_action_to_log(bug => $bug,
 477                                get_lock => 0,
 478                                __return_append_to_log_options(
 479                                  %param,
 480                                  action => $action,
 481                                 )
 482                               )
 483                if not exists $param{append_log} or $param{append_log};
 484           writebug($bug,$newdata);
 485           add_recipients(recipients => $param{recipients},
 486                          data       => $newdata,
 487                         );
 488      }
 489      print {$debug} "$param{bug} unlocking $locks\n";
 490      if ($locks) {
 491           for (1..$locks) { unfilelock(); };
 492      }
 493      if (exists $param{bugs_affected}) {
 494           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 495      }
 496      print {$debug} "$param{bug} unlocking done\n";
 497 }
 498
 499 =head2 append_action_to_log
 500
 501      append_action_to_log
 502
 503 This should probably be moved to Debbugs::Log; have to think that out
 504 some more.
 505
 506 =cut
 507
 508 sub append_action_to_log{
 509      my %param = validate_with(params => \@_,
 510                                spec   => {bug => {type   => SCALAR,
 511                                                   regex  => qr/^\d+/,
 512                                                  },
 513                                           action => {type => SCALAR,
 514                                                     },
 515                                           requester => {type => SCALAR,
 516                                                        },
 517                                           request_addr => {type => SCALAR,
 518                                                           },
 519                                           location => {type => SCALAR,
 520                                                        optional => 1,
 521                                                       },
 522                                           message  => {type => SCALAR|ARRAYREF,
 523                                                       },
 524                                           get_lock   => {type => BOOLEAN,
 525                                                          default => 1,
 526                                                         },
 527                                          }
 528                               );
 529      # Fix this to use $param{location}
 530      my $log_location = buglog($param{bug});
 531      die "Unable to find .log for $param{bug}"
 532           if not defined $log_location;
 533      if ($param{get_lock}) {
 534           filelock("lock/$param{bug}");
 535      }
 536      my $log = IO::File->new(">>$log_location") or
 537           die "Unable to open $log_location for appending: $!";
 538      print {$log} "\6\n".
 539           "<!-- time:".time." -->\n".
 540           "<strong>".html_escape($param{action})."</strong>\n".
 541           "Request was from <code>".html_escape($param{requester})."</code>\n".
 542           "to <code>".html_escape($param{request_addr})."</code>. \n".
 543           "\3\n".
 544           "\7\n",escape_log(make_list($param{message})),"\n\3\n"
 545                or die "Unable to append to $log_location: $!";
 546      close $log or die "Unable to close $log_location: $!";
 547      if ($param{get_lock}) {
 548           unlockfile();
 549      }
 550
 551
 552 }
 553
 554
 555 =head1 PRIVATE FUNCTIONS
 556
 557 =head2 __handle_debug_transcript
 558
 559      my ($debug,$transcript) = __handle_debug_transcript(%param);
 560
 561 Returns a debug and transcript filehandle
 562
 563
 564 =cut
 565
 566 sub __handle_debug_transcript{
 567      my %param = validate_with(params => \@_,
 568                                spec   => {%common_options},
 569                                allow_extra => 1,
 570                               );
 571      my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
 572      my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
 573      return ($debug,$transcript);
 574 }
 575
 576 sub __return_append_to_log_options{
 577      my %param = @_;
 578      my $action = $param{action} if exists $param{action};
 579      if (not exists $param{requester}) {
 580           $param{requester} = $config{control_internal_requester};
 581      }
 582      if (not exists $param{request_addr}) {
 583           $param{request_addr} = $config{control_internal_request_addr};
 584      }
 585      if (not exists $param{message}) {
 586           my $date = rfc822_date();
 587           $param{message} = fill_in_template(template  => 'mail/fake_control_message',
 588                                              variables => {request_addr => $param{request_addr},
 589                                                            requester    => $param{requester},
 590                                                            date         => $date,
 591                                                            action       => $action
 592                                                           },
 593                                             );
 594      }
 595      if (not defined $action) {
 596           carp "Undefined action!";
 597           $action = "unknown action";
 598      }
 599      return (action => $action,
 600              (map {exists $append_action_options{$_}?($_,$param{$_}):()}
 601               keys %param),
 602             );
 603 }
 604
 605
 606 1;
 607
 608 __END__