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