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