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