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