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 GENERAL 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 = (affects => [qw(affects)],
  82                      summary => [qw(summary)],
  83                      owner   => [qw(owner)],
  84                      archive => [qw(bug_archive bug_unarchive),
  85                                 ],
  86                      log     => [qw(append_action_to_log),
  87                                 ],
  88                     );
  89      @EXPORT_OK = ();
  90      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  91      $EXPORT_TAGS{all} = [@EXPORT_OK];
  92 }
  93
  94 use Debbugs::Config qw(:config);
  95 use Debbugs::Common qw(:lock buglog :misc get_hashname);
  96 use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages);
  97 use Debbugs::CGI qw(html_escape);
  98 use Debbugs::Log qw(:misc);
  99 use Debbugs::Recipients qw(:add);
 100
 101 use Params::Validate qw(validate_with :types);
 102 use File::Path qw(mkpath);
 103 use IO::File;
 104
 105 use Debbugs::Text qw(:templates);
 106
 107 use Debbugs::Mail qw(rfc822_date);
 108
 109 use POSIX qw(strftime);
 110
 111 use Carp;
 112
 113 # These are a set of options which are common to all of these functions
 114
 115 my %common_options = (debug       => {type => SCALARREF|HANDLE,
 116                                       optional => 1,
 117                                      },
 118                       transcript  => {type => SCALARREF|HANDLE,
 119                                       optional => 1,
 120                                      },
 121                       affected_bugs => {type => HASHREF,
 122                                         optional => 1,
 123                                        },
 124                       affected_packages => {type => HASHREF,
 125                                             optional => 1,
 126                                            },
 127                       recipients    => {type => HASHREF,
 128                                         default => {},
 129                                        },
 130                       limit         => {type => HASHREF,
 131                                         default => {},
 132                                        },
 133                      );
 134
 135
 136 my %append_action_options =
 137      (action => {type => SCALAR,
 138                  optional => 1,
 139                 },
 140       requester => {type => SCALAR,
 141                     optional => 1,
 142                    },
 143       request_addr => {type => SCALAR,
 144                        optional => 1,
 145                       },
 146       location => {type => SCALAR,
 147                    optional => 1,
 148                   },
 149       message  => {type => SCALAR|ARRAYREF,
 150                    optional => 1,
 151                   },
 152       append_log => {type => BOOLEAN,
 153                      optional => 1,
 154                      depends => [qw(requester request_addr),
 155                                  qw(message),
 156                                 ],
 157                     },
 158      );
 159
 160
 161 # this is just a generic stub for Debbugs::Control functions.
 162 #
 163 # =head2 foo
 164 #
 165 #      eval {
 166 #           foo(bug          => $ref,
 167 #               transcript   => $transcript,
 168 #               ($dl > 0 ? (debug => $transcript):()),
 169 #               requester    => $header{from},
 170 #               request_addr => $controlrequestaddr,
 171 #               message      => \@log,
 172 #               affected_packages => \%affected_packages,
 173 #               recipients   => \%recipients,
 174 #               summary      => undef,
 175 #              );
 176 #       };
 177 #       if ($@) {
 178 #           $errors++;
 179 #           print {$transcript} "Failed to foo $ref bar: $@";
 180 #       }
 181 #
 182 # Foo frobinates
 183 #
 184 # =cut
 185 #
 186 # sub foo {
 187 #     my %param = validate_with(params => \@_,
 188 #                             spec   => {bug => {type   => SCALAR,
 189 #                                                regex  => qr/^\d+$/,
 190 #                                               },
 191 #                                        # specific options here
 192 #                                        %common_options,
 193 #                                        %append_action_options,
 194 #                                       },
 195 #                            );
 196 #     our $locks = 0;
 197 #     $locks = 0;
 198 #     local $SIG{__DIE__} = sub {
 199 #       if ($locks) {
 200 #           for (1..$locks) { unfilelock(); }
 201 #           $locks = 0;
 202 #       }
 203 #     };
 204 #     my ($debug,$transcript) = __handle_debug_transcript(%param);
 205 #     my (@data);
 206 #     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 207 #     __handle_affected_packages(data => \@data,%param);
 208 #     print {$transcript} __bug_info(@data);
 209 #     add_recipients(data => \@data,
 210 #                    recipients => $param{recipients}
 211 #                   );
 212 #     for my $data (@data) {
 213 #        append_action_to_log(bug => $data->{bug_num},
 214 #                             get_lock => 0,
 215 #                             __return_append_to_log_options(
 216 #                                                            %param,
 217 #                                                            action => $action,
 218 #                                                           ),
 219 #                            )
 220 #              if not exists $param{append_log} or $param{append_log};
 221 #         writebug($data->{bug_num},$data);
 222 #         print {$transcript} "$action\n";
 223 #         add_recipients(data => $data,
 224 #                        recipients => $param{recipients},
 225 #                       );
 226 #      }
 227 #      if ($locks) {
 228 #         for (1..$locks) { unfilelock(); }
 229 #      }
 230 #
 231 # }
 232
 233 =head2 affects
 234
 235      eval {
 236             affects(bug          => $ref,
 237                     transcript   => $transcript,
 238                     ($dl > 0 ? (debug => $transcript):()),
 239                     requester    => $header{from},
 240                     request_addr => $controlrequestaddr,
 241                     message      => \@log,
 242                     affected_packages => \%affected_packages,
 243                     recipients   => \%recipients,
 244                     packages     => undef,
 245                     add          => 1,
 246                     remove       => 0,
 247                    );
 248         };
 249         if ($@) {
 250             $errors++;
 251             print {$transcript} "Failed to mark $ref as affecting $packages: $@";
 252         }
 253
 254 This marks a bug as affecting packages which the bug is not actually
 255 in. This should only be used in cases where fixing the bug instantly
 256 resolves the problem in the other packages.
 257
 258 By default, the packages are set to the list of packages passed.
 259 However, if you pass add => 1 or remove => 1, the list of packages
 260 passed are added or removed from the affects list, respectively.
 261
 262 =cut
 263
 264 sub affects {
 265     my %param = validate_with(params => \@_,
 266                               spec   => {bug => {type   => SCALAR,
 267                                                  regex  => qr/^\d+$/,
 268                                                 },
 269                                          # specific options here
 270                                          packages => {type => SCALAR|ARRAYREF,
 271                                                       default => [],
 272                                                      },
 273                                          add      => {type => BOOLEAN,
 274                                                       default => 0,
 275                                                      },
 276                                          remove   => {type => BOOLEAN,
 277                                                       default => 0,
 278                                                      },
 279                                          %common_options,
 280                                          %append_action_options,
 281                                         },
 282                              );
 283     if ($param{add} and $param{remove}) {
 284          croak "Asking to both add and remove affects is nonsensical";
 285     }
 286     our $locks = 0;
 287     $locks = 0;
 288     local $SIG{__DIE__} = sub {
 289         if ($locks) {
 290             for (1..$locks) { unfilelock(); }
 291             $locks = 0;
 292         }
 293     };
 294     my ($debug,$transcript) = __handle_debug_transcript(%param);
 295     my (@data);
 296     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 297     __handle_affected_packages(data => \@data,%param);
 298     print {$transcript} __bug_info(@data);
 299     add_recipients(data => \@data,
 300                    recipients => $param{recipients}
 301                   );
 302     my $action = 'Did not alter affected packages';
 303     for my $data (@data) {
 304          print {$debug} "Going to change affects\n";
 305          my @packages = splitpackages($data->{affects});
 306          my %packages;
 307          @packages{@packages} = (1) x @packages;
 308          if ($param{add}) {
 309               my @added = ();
 310               for my $package (make_list($param{packages})) {
 311                    if (not $packages{$package}) {
 312                         $packages{$package} = 1;
 313                         push @added,$package;
 314                    }
 315               }
 316               if (@added) {
 317                    $action = "Added indication that $data->{bug_num} affects ".
 318                         english_join(', ',' and ',@added);
 319               }
 320          }
 321          elsif ($param{remove}) {
 322               my @removed = ();
 323               for my $package (make_list($param{packages})) {
 324                    if ($packages{$package}) {
 325                         delete $packages{$package};
 326                         push @removed,$package;
 327                    }
 328               }
 329               $action = "Removed indication that $data->{bug_num} affects " .
 330                    english_join(', ',' and ',@removed);
 331          }
 332          else {
 333               %packages = ();
 334               for my $package (make_list($param{packages})) {
 335                    $packages{$package} = 1;
 336               }
 337               $action = "Noted that $data->{bug_num} affects ".
 338                    english_join(', ',' and ', keys %packages);
 339          }
 340          $data->{affects} = join(',',keys %packages);
 341          append_action_to_log(bug => $data->{bug_num},
 342                               get_lock => 0,
 343                               __return_append_to_log_options(
 344                                                              %param,
 345                                                              action => $action,
 346                                                             ),
 347                              )
 348                if not exists $param{append_log} or $param{append_log};
 349           writebug($data->{bug_num},$data);
 350           print {$transcript} "$action\n";
 351           add_recipients(data => $data,
 352                          recipients => $param{recipients},
 353                         );
 354      }
 355      if ($locks) {
 356           for (1..$locks) { unfilelock(); }
 357      }
 358
 359 }
 360
 361
 362 =head1 SUMMARY FUNCTIONS
 363
 364 =head2 summary
 365
 366      eval {
 367             summary(bug          => $ref,
 368                     transcript   => $transcript,
 369                     ($dl > 0 ? (debug => $transcript):()),
 370                     requester    => $header{from},
 371                     request_addr => $controlrequestaddr,
 372                     message      => \@log,
 373                     affected_packages => \%affected_packages,
 374                     recipients   => \%recipients,
 375                     summary      => undef,
 376                    );
 377         };
 378         if ($@) {
 379             $errors++;
 380             print {$transcript} "Failed to mark $ref with summary foo: $@";
 381         }
 382
 383 Handles all setting of summary fields
 384
 385 If summary is undef, unsets the summary
 386
 387 If summary is 0, sets the summary to the first paragraph contained in
 388 the message passed.
 389
 390 If summary is numeric, sets the summary to the message specified.
 391
 392
 393 =cut
 394
 395
 396 sub summary {
 397     my %param = validate_with(params => \@_,
 398                               spec   => {bug => {type   => SCALAR,
 399                                                  regex  => qr/^\d+$/,
 400                                                 },
 401                                          # specific options here
 402                                          summary => {type => SCALAR|UNDEF,
 403                                                      default => 0,
 404                                                     },
 405                                          %common_options,
 406                                          %append_action_options,
 407                                         },
 408                              );
 409     croak "summary must be numeric or undef" if
 410          defined $param{summary} and not $param{summary} =~ /^\d+$/;
 411     our $locks = 0;
 412     $locks = 0;
 413     local $SIG{__DIE__} = sub {
 414         if ($locks) {
 415             for (1..$locks) { unfilelock(); }
 416             $locks = 0;
 417         }
 418     };
 419     my ($debug,$transcript) = __handle_debug_transcript(%param);
 420     my (@data);
 421     ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 422     __handle_affected_packages(data => \@data,%param);
 423     print {$transcript} __bug_info(@data);
 424     add_recipients(data => \@data,
 425                    recipients => $param{recipients}
 426                   );
 427     # figure out the log that we're going to use
 428     my $summary = '';
 429     my $summary_msg = '';
 430     my $action = '';
 431     if (not defined $param{summary}) {
 432          # do nothing
 433          print {$debug} "Removing summary fields";
 434          $action = 'Removed summary';
 435     }
 436     else {
 437          my $log = [];
 438          my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
 439          if ($param{summary} == 0) {
 440               $log = $param{log};
 441               $summary_msg = @records + 1;
 442          }
 443          else {
 444               if (($param{summary} - 1 ) > $#records) {
 445                    die "Message number '$param{summary}' exceeds the maximum message '$#records'";
 446               }
 447               my $record = $records[($param{summary} - 1 )];
 448               if ($record->{type} !~ /incoming-recv|recips/) {
 449                    die "Message number '$param{summary}' is a invalid message type '$record->{type}'";
 450               }
 451               $summary_msg = $param{summary};
 452               $log = [$record->{text}];
 453          }
 454          my $p_o = Debbugs::MIME::parse(join('',@{$log}));
 455          my $body = $p_o->{body};
 456          my $in_pseudoheaders = 0;
 457          my $paragraph = '';
 458          # walk through body until we get non-blank lines
 459          for my $line (@{$body}) {
 460               if ($line =~ /^\s*$/) {
 461                    if (length $paragraph) {
 462                         last;
 463                    }
 464                    $in_pseudoheaders = 0;
 465                    next;
 466               }
 467               # skip a paragraph if it looks like it's control or
 468               # pseudo-headers
 469               if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
 470                                  (?:package|(?:no|)owner|severity|tag|summary| #control
 471                                       reopen|close|(?:not|)(?:fixed|found)|clone|
 472                                       (?:force|)merge|user(?:category|tag|)
 473                                  )
 474                             )\s+\S}x) {
 475                    if (not length $paragraph) {
 476                         print {$debug} "Found control/pseudo-headers and skiping them\n";
 477                         $in_pseudoheaders = 1;
 478                         next;
 479                    }
 480               }
 481               next if $in_pseudoheaders;
 482               $paragraph .= $line;
 483          }
 484          print {$debug} "Summary is going to be '$paragraph'\n";
 485          $summary = $paragraph;
 486          $summary =~ s/[\n\r]//g;
 487          if (not length $summary) {
 488               die "Unable to find summary message to use";
 489          }
 490     }
 491     for my $data (@data) {
 492          print {$debug} "Going to change summary";
 493          if (length $summary) {
 494               if (length $data->{summary}) {
 495                    $action = "Summary replaced with message bug $param{bug} message $summary_msg";
 496               }
 497               else {
 498                    $action = "Summary recorded from message bug $param{bug} message $summary_msg";
 499               }
 500          }
 501          $data->{summary} = $summary;
 502          append_action_to_log(bug => $data->{bug_num},
 503                               get_lock => 0,
 504                               __return_append_to_log_options(
 505                                                              %param,
 506                                                              action => $action,
 507                                                             ),
 508                              )
 509                if not exists $param{append_log} or $param{append_log};
 510           writebug($data->{bug_num},$data);
 511           print {$transcript} "$action\n";
 512           add_recipients(data => $data,
 513                          recipients => $param{recipients},
 514                         );
 515      }
 516      if ($locks) {
 517           for (1..$locks) { unfilelock(); }
 518      }
 519
 520 }
 521
 522
 523
 524
 525 =head1 OWNER FUNCTIONS
 526
 527 =head2 owner
 528
 529      eval {
 530             owner(bug          => $ref,
 531                   transcript   => $transcript,
 532                   ($dl > 0 ? (debug => $transcript):()),
 533                   requester    => $header{from},
 534                   request_addr => $controlrequestaddr,
 535                   message      => \@log,
 536                   recipients   => \%recipients,
 537                   owner        => undef,
 538                  );
 539         };
 540         if ($@) {
 541             $errors++;
 542             print {$transcript} "Failed to mark $ref as having an owner: $@";
 543         }
 544
 545 Handles all setting of the owner field; given an owner of undef or of
 546 no length, indicates that a bug is not owned by anyone.
 547
 548 =cut
 549
 550 sub owner {
 551      my %param = validate_with(params => \@_,
 552                                spec   => {bug => {type   => SCALAR,
 553                                                   regex  => qr/^\d+$/,
 554                                                  },
 555                                           owner => {type => SCALAR|UNDEF,
 556                                                    },
 557                                           %common_options,
 558                                           %append_action_options,
 559                                          },
 560                               );
 561      our $locks = 0;
 562      $locks = 0;
 563      local $SIG{__DIE__} = sub {
 564           if ($locks) {
 565                for (1..$locks) { unfilelock(); }
 566                $locks = 0;
 567           }
 568      };
 569      my ($debug,$transcript) = __handle_debug_transcript(%param);
 570      my (@data);
 571      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 572      __handle_affected_packages(data => \@data,%param);
 573      print {$transcript} __bug_info(@data);
 574      @data and defined $data[0] or die "No bug found for $param{bug}";
 575      add_recipients(data => \@data,
 576                     recipients => $param{recipients}
 577                    );
 578      my $action = '';
 579      for my $data (@data) {
 580           print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
 581           print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
 582           if (not defined $param{owner} or not length $param{owner}) {
 583                $param{owner} = '';
 584                $action = "Removed annotation that $config{bug} was owned by " .
 585                     "$data->{owner}.";
 586           }
 587           else {
 588                if (length $data->{owner}) {
 589                     $action = "Owner changed from $data->{owner} to $param{owner}.";
 590                }
 591                else {
 592                     $action = "Owner recorded as $param{owner}."
 593                }
 594           }
 595           $data->{owner} = $param{owner};
 596           append_action_to_log(bug => $data->{bug_num},
 597                                get_lock => 0,
 598                __return_append_to_log_options(
 599                                               %param,
 600                                               action => $action,
 601                                              ),
 602                               )
 603                if not exists $param{append_log} or $param{append_log};
 604           writebug($data->{bug_num},$data);
 605           print {$transcript} "$action\n";
 606           add_recipients(data => $data,
 607                          recipients => $param{recipients},
 608                         );
 609      }
 610      if ($locks) {
 611           for (1..$locks) { unfilelock(); }
 612      }
 613 }
 614
 615
 616 =head1 ARCHIVE FUNCTIONS
 617
 618
 619 =head2 bug_archive
 620
 621      my $error = '';
 622      eval {
 623         bug_archive(bug => $bug_num,
 624                     debug => \$debug,
 625                     transcript => \$transcript,
 626                    );
 627      };
 628      if ($@) {
 629         $errors++;
 630         transcript("Unable to archive $bug_num\n");
 631         warn $@;
 632      }
 633      transcript($transcript);
 634
 635
 636 This routine archives a bug
 637
 638 =over
 639
 640 =item bug -- bug number
 641
 642 =item check_archiveable -- check wether a bug is archiveable before
 643 archiving; defaults to 1
 644
 645 =item archive_unarchived -- whether to archive bugs which have not
 646 previously been archived; defaults to 1. [Set to 0 when used from
 647 control@]
 648
 649 =item ignore_time -- whether to ignore time constraints when archiving
 650 a bug; defaults to 0.
 651
 652 =back
 653
 654 =cut
 655
 656 sub bug_archive {
 657      my %param = validate_with(params => \@_,
 658                                spec   => {bug => {type   => SCALAR,
 659                                                   regex  => qr/^\d+$/,
 660                                                  },
 661                                           check_archiveable => {type => BOOLEAN,
 662                                                                 default => 1,
 663                                                                },
 664                                           archive_unarchived => {type => BOOLEAN,
 665                                                                  default => 1,
 666                                                                 },
 667                                           ignore_time => {type => BOOLEAN,
 668                                                           default => 0,
 669                                                          },
 670                                           %common_options,
 671                                           %append_action_options,
 672                                          },
 673                               );
 674      our $locks = 0;
 675      $locks = 0;
 676      local $SIG{__DIE__} = sub {
 677           if ($locks) {
 678                for (1..$locks) { unfilelock(); }
 679                $locks = 0;
 680           }
 681      };
 682      my $action = "$config{bug} archived.";
 683      my ($debug,$transcript) = __handle_debug_transcript(%param);
 684      if ($param{check_archiveable} and
 685          not bug_archiveable(bug=>$param{bug},
 686                              ignore_time => $param{ignore_time},
 687                             )) {
 688           print {$transcript} "Bug $param{bug} cannot be archived\n";
 689           die "Bug $param{bug} cannot be archived";
 690      }
 691      print {$debug} "$param{bug} considering\n";
 692      my (@data);
 693      ($locks, @data) = lock_read_all_merged_bugs($param{bug});
 694      __handle_affected_packages(data => \@data,%param);
 695      print {$transcript} __bug_info(@data);
 696      print {$debug} "$param{bug} read $locks\n";
 697      @data and defined $data[0] or die "No bug found for $param{bug}";
 698      print {$debug} "$param{bug} read done\n";
 699
 700      if (not $param{archive_unarchived} and
 701          not exists $data[0]{unarchived}
 702         ) {
 703           print {$transcript} "$param{bug} has not been archived previously\n";
 704           die "$param{bug} has not been archived previously";
 705      }
 706      add_recipients(recipients => $param{recipients},
 707                     data => \@data,
 708                    );
 709      my @bugs = map {$_->{bug_num}} @data;
 710      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 711      for my $bug (@bugs) {
 712          if ($param{check_archiveable}) {
 713              die "Bug $bug cannot be archived (but $param{bug} can?)"
 714                  unless bug_archiveable(bug=>$bug,
 715                                         ignore_time => $param{ignore_time},
 716                                        );
 717          }
 718      }
 719      # If we get here, we can archive/remove this bug
 720      print {$debug} "$param{bug} removing\n";
 721      for my $bug (@bugs) {
 722           #print "$param{bug} removing $bug\n" if $debug;
 723           my $dir = get_hashname($bug);
 724           # First indicate that this bug is being archived
 725           append_action_to_log(bug => $bug,
 726                                get_lock => 0,
 727                                __return_append_to_log_options(
 728                                  %param,
 729                                  action => $action,
 730                                 )
 731                               )
 732                if not exists $param{append_log} or $param{append_log};
 733           my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
 734           if ($config{save_old_bugs}) {
 735                mkpath("$config{spool_dir}/archive/$dir");
 736                foreach my $file (@files_to_remove) {
 737                     link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
 738                          copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
 739                }
 740
 741                print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
 742           }
 743           unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
 744           print {$transcript} "deleted $bug (from $param{bug})\n";
 745      }
 746      bughook_archive(@bugs);
 747      if (exists $param{bugs_affected}) {
 748           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 749      }
 750      print {$debug} "$param{bug} unlocking $locks\n";
 751      if ($locks) {
 752           for (1..$locks) { unfilelock(); }
 753      }
 754      print {$debug} "$param{bug} unlocking done\n";
 755 }
 756
 757 =head2 bug_unarchive
 758
 759      my $error = '';
 760      eval {
 761         bug_unarchive(bug => $bug_num,
 762                       debug => \$debug,
 763                       transcript => \$transcript,
 764                      );
 765      };
 766      if ($@) {
 767         $errors++;
 768         transcript("Unable to archive bug: $bug_num");
 769      }
 770      transcript($transcript);
 771
 772 This routine unarchives a bug
 773
 774 =cut
 775
 776 sub bug_unarchive {
 777      my %param = validate_with(params => \@_,
 778                                spec   => {bug => {type   => SCALAR,
 779                                                   regex  => qr/^\d+/,
 780                                                  },
 781                                           %common_options,
 782                                           %append_action_options,
 783                                          },
 784                               );
 785      our $locks = 0;
 786      local $SIG{__DIE__} = sub {
 787           if ($locks) {
 788                for (1..$locks) { unfilelock(); }
 789                $locks = 0;
 790           }
 791      };
 792      my $action = "$config{bug} unarchived.";
 793      my ($debug,$transcript) = __handle_debug_transcript(%param);
 794      print {$debug} "$param{bug} considering\n";
 795      my @data = ();
 796      ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
 797      __handle_affected_packages(data => \@data,%param);
 798      print {$transcript} __bug_info(@data);
 799      print {$debug} "$param{bug} read $locks\n";
 800      if (not @data or not defined $data[0]) {
 801          print {$transcript} "No bug found for $param{bug}\n";
 802          die "No bug found for $param{bug}";
 803      }
 804      print {$debug} "$param{bug} read done\n";
 805      my @bugs = map {$_->{bug_num}} @data;
 806      print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
 807      print {$debug} "$param{bug} unarchiving\n";
 808      my @files_to_remove;
 809      for my $bug (@bugs) {
 810           print {$debug} "$param{bug} removing $bug\n";
 811           my $dir = get_hashname($bug);
 812           my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
 813           mkpath("archive/$dir");
 814           foreach my $file (@files_to_copy) {
 815                # die'ing here sucks
 816                link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 817                     copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
 818                          die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
 819           }
 820           push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
 821           print {$transcript} "Unarchived $config{bug} $bug\n";
 822      }
 823      unlink(@files_to_remove) or die "Unable to unlink bugs";
 824      # Indicate that this bug has been archived previously
 825      for my $bug (@bugs) {
 826           my $newdata = readbug($bug);
 827           if (not defined $newdata) {
 828                print {$transcript} "$config{bug} $bug disappeared!\n";
 829                die "Bug $bug disappeared!";
 830           }
 831           $newdata->{unarchived} = time;
 832           append_action_to_log(bug => $bug,
 833                                get_lock => 0,
 834                                __return_append_to_log_options(
 835                                  %param,
 836                                  action => $action,
 837                                 )
 838                               )
 839                if not exists $param{append_log} or $param{append_log};
 840           writebug($bug,$newdata);
 841           add_recipients(recipients => $param{recipients},
 842                          data       => $newdata,
 843                         );
 844      }
 845      print {$debug} "$param{bug} unlocking $locks\n";
 846      if ($locks) {
 847           for (1..$locks) { unfilelock(); };
 848      }
 849      if (exists $param{bugs_affected}) {
 850           @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
 851      }
 852      print {$debug} "$param{bug} unlocking done\n";
 853 }
 854
 855 =head2 append_action_to_log
 856
 857      append_action_to_log
 858
 859 This should probably be moved to Debbugs::Log; have to think that out
 860 some more.
 861
 862 =cut
 863
 864 sub append_action_to_log{
 865      my %param = validate_with(params => \@_,
 866                                spec   => {bug => {type   => SCALAR,
 867                                                   regex  => qr/^\d+/,
 868                                                  },
 869                                           action => {type => SCALAR,
 870                                                     },
 871                                           requester => {type => SCALAR,
 872                                                        },
 873                                           request_addr => {type => SCALAR,
 874                                                           },
 875                                           location => {type => SCALAR,
 876                                                        optional => 1,
 877                                                       },
 878                                           message  => {type => SCALAR|ARRAYREF,
 879                                                       },
 880                                           get_lock   => {type => BOOLEAN,
 881                                                          default => 1,
 882                                                         },
 883                                          }
 884                               );
 885      # Fix this to use $param{location}
 886      my $log_location = buglog($param{bug});
 887      die "Unable to find .log for $param{bug}"
 888           if not defined $log_location;
 889      if ($param{get_lock}) {
 890           filelock("lock/$param{bug}");
 891      }
 892      my $log = IO::File->new(">>$log_location") or
 893           die "Unable to open $log_location for appending: $!";
 894      print {$log} "\6\n".
 895           "<!-- time:".time." -->\n".
 896           "<strong>".html_escape($param{action})."</strong>\n".
 897           "Request was from <code>".html_escape($param{requester})."</code>\n".
 898           "to <code>".html_escape($param{request_addr})."</code>. \n".
 899           "\3\n".
 900           "\7\n",escape_log(make_list($param{message})),"\n\3\n"
 901                or die "Unable to append to $log_location: $!";
 902      close $log or die "Unable to close $log_location: $!";
 903      if ($param{get_lock}) {
 904           unlockfile();
 905      }
 906
 907
 908 }
 909
 910
 911 =head1 PRIVATE FUNCTIONS
 912
 913 =head2 __handle_affected_packages
 914
 915      __handle_affected_packages(affected_packages => {},
 916                                 data => [@data],
 917                                )
 918
 919
 920
 921 =cut
 922
 923 sub __handle_affected_packages{
 924      my %param = validate_with(params => \@_,
 925                                spec   => {%common_options,
 926                                           data => {type => ARRAYREF|HASHREF
 927                                                   },
 928                                          },
 929                                allow_extra => 1,
 930                               );
 931      for my $data (make_list($param{data})) {
 932           $param{affected_packages}{$data->{package}} = 1;
 933      }
 934 }
 935
 936 =head2 __handle_debug_transcript
 937
 938      my ($debug,$transcript) = __handle_debug_transcript(%param);
 939
 940 Returns a debug and transcript filehandle
 941
 942
 943 =cut
 944
 945 sub __handle_debug_transcript{
 946      my %param = validate_with(params => \@_,
 947                                spec   => {%common_options},
 948                                allow_extra => 1,
 949                               );
 950      my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
 951      my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
 952      return ($debug,$transcript);
 953 }
 954
 955 =head2 __bug_info
 956
 957      __bug_info($data)
 958
 959 Produces a small bit of bug information to kick out to the transcript
 960
 961 =cut
 962
 963 sub __bug_info{
 964      my $return = '';
 965      for my $data (@_) {
 966           $return .= "Bug ".($data->{bug_num}||'').
 967                " [".($data->{package}||''). "] ".
 968                     ($data->{subject}||'')."\n";
 969      }
 970      return $return;
 971 }
 972
 973
 974 sub __return_append_to_log_options{
 975      my %param = @_;
 976      my $action = $param{action} if exists $param{action};
 977      if (not exists $param{requester}) {
 978           $param{requester} = $config{control_internal_requester};
 979      }
 980      if (not exists $param{request_addr}) {
 981           $param{request_addr} = $config{control_internal_request_addr};
 982      }
 983      if (not exists $param{message}) {
 984           my $date = rfc822_date();
 985           $param{message} = fill_in_template(template  => 'mail/fake_control_message',
 986                                              variables => {request_addr => $param{request_addr},
 987                                                            requester    => $param{requester},
 988                                                            date         => $date,
 989                                                            action       => $action
 990                                                           },
 991                                             );
 992      }
 993      if (not defined $action) {
 994           carp "Undefined action!";
 995           $action = "unknown action";
 996      }
 997      return (action => $action,
 998              (map {exists $append_action_options{$_}?($_,$param{$_}):()}
 999               keys %param),
1000             );
1001 }
1002
1003
1004 1;
1005
1006 __END__