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