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