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.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
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.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item location -- Optional location; currently ignored but may be
53 supported in the future for updating archived bugs upon archival
55 =item message -- The original message which caused the action to be taken
57 =item append_log -- Whether or not to append information to the log.
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.
67 =head1 GENERAL FUNCTIONS
73 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
74 use base qw(Exporter);
78 $DEBUG = 0 unless defined $DEBUG;
81 %EXPORT_TAGS = (affects => [qw(affects)],
82 summary => [qw(summary)],
84 archive => [qw(bug_archive bug_unarchive),
86 log => [qw(append_action_to_log),
90 Exporter::export_ok_tags(keys %EXPORT_TAGS);
91 $EXPORT_TAGS{all} = [@EXPORT_OK];
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);
101 use Params::Validate qw(validate_with :types);
102 use File::Path qw(mkpath);
105 use Debbugs::Text qw(:templates);
107 use Debbugs::Mail qw(rfc822_date);
109 use POSIX qw(strftime);
113 # These are a set of options which are common to all of these functions
115 my %common_options = (debug => {type => SCALARREF|HANDLE,
118 transcript => {type => SCALARREF|HANDLE,
121 affected_bugs => {type => HASHREF,
124 affected_packages => {type => HASHREF,
127 recipients => {type => HASHREF,
130 limit => {type => HASHREF,
136 my %append_action_options =
137 (action => {type => SCALAR,
140 requester => {type => SCALAR,
143 request_addr => {type => SCALAR,
146 location => {type => SCALAR,
149 message => {type => SCALAR|ARRAYREF,
152 append_log => {type => BOOLEAN,
154 depends => [qw(requester request_addr),
161 # this is just a generic stub for Debbugs::Control functions.
167 # transcript => $transcript,
168 # ($dl > 0 ? (debug => $transcript):()),
169 # requester => $header{from},
170 # request_addr => $controlrequestaddr,
172 # affected_packages => \%affected_packages,
173 # recipients => \%recipients,
179 # print {$transcript} "Failed to foo $ref bar: $@";
187 # my %param = validate_with(params => \@_,
188 # spec => {bug => {type => SCALAR,
189 # regex => qr/^\d+$/,
191 # # specific options here
193 # %append_action_options,
198 # local $SIG{__DIE__} = sub {
200 # for (1..$locks) { unfilelock(); }
204 # my ($debug,$transcript) = __handle_debug_transcript(%param);
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}
212 # for my $data (@data) {
213 # append_action_to_log(bug => $data->{bug_num},
215 # __return_append_to_log_options(
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},
228 # for (1..$locks) { unfilelock(); }
237 transcript => $transcript,
238 ($dl > 0 ? (debug => $transcript):()),
239 requester => $header{from},
240 request_addr => $controlrequestaddr,
242 affected_packages => \%affected_packages,
243 recipients => \%recipients,
251 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
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.
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.
265 my %param = validate_with(params => \@_,
266 spec => {bug => {type => SCALAR,
269 # specific options here
270 packages => {type => SCALAR|ARRAYREF,
273 add => {type => BOOLEAN,
276 remove => {type => BOOLEAN,
280 %append_action_options,
283 if ($param{add} and $param{remove}) {
284 croak "Asking to both add and remove affects is nonsensical";
288 local $SIG{__DIE__} = sub {
290 for (1..$locks) { unfilelock(); }
294 my ($debug,$transcript) = __handle_debug_transcript(%param);
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}
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});
307 @packages{@packages} = (1) x @packages;
310 for my $package (make_list($param{packages})) {
311 if (not $packages{$package}) {
312 $packages{$package} = 1;
313 push @added,$package;
317 $action = "Added indication that $data->{bug_num} affects ".
318 english_join(', ',' and ',@added);
321 elsif ($param{remove}) {
323 for my $package (make_list($param{packages})) {
324 if ($packages{$package}) {
325 delete $packages{$package};
326 push @removed,$package;
329 $action = "Removed indication that $data->{bug_num} affects " .
330 english_join(', ',' and ',@removed);
334 for my $package (make_list($param{packages})) {
335 $packages{$package} = 1;
337 $action = "Noted that $data->{bug_num} affects ".
338 english_join(', ',' and ', keys %packages);
340 $data->{affects} = join(',',keys %packages);
341 append_action_to_log(bug => $data->{bug_num},
343 __return_append_to_log_options(
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},
356 for (1..$locks) { unfilelock(); }
362 =head1 SUMMARY FUNCTIONS
368 transcript => $transcript,
369 ($dl > 0 ? (debug => $transcript):()),
370 requester => $header{from},
371 request_addr => $controlrequestaddr,
373 affected_packages => \%affected_packages,
374 recipients => \%recipients,
380 print {$transcript} "Failed to mark $ref with summary foo: $@";
383 Handles all setting of summary fields
385 If summary is undef, unsets the summary
387 If summary is 0, sets the summary to the first paragraph contained in
390 If summary is numeric, sets the summary to the message specified.
397 my %param = validate_with(params => \@_,
398 spec => {bug => {type => SCALAR,
401 # specific options here
402 summary => {type => SCALAR|UNDEF,
406 %append_action_options,
409 croak "summary must be numeric or undef" if
410 defined $param{summary} and not $param{summary} =~ /^\d+$/;
413 local $SIG{__DIE__} = sub {
415 for (1..$locks) { unfilelock(); }
419 my ($debug,$transcript) = __handle_debug_transcript(%param);
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}
427 # figure out the log that we're going to use
429 my $summary_msg = '';
431 if (not defined $param{summary}) {
433 print {$debug} "Removing summary fields";
434 $action = 'Removed summary';
438 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
439 if ($param{summary} == 0) {
441 $summary_msg = @records + 1;
444 if (($param{summary} - 1 ) > $#records) {
445 die "Message number '$param{summary}' exceeds the maximum message '$#records'";
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}'";
451 $summary_msg = $param{summary};
452 $log = [$record->{text}];
454 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
455 my $body = $p_o->{body};
456 my $in_pseudoheaders = 0;
458 # walk through body until we get non-blank lines
459 for my $line (@{$body}) {
460 if ($line =~ /^\s*$/) {
461 if (length $paragraph) {
464 $in_pseudoheaders = 0;
467 # skip a paragraph if it looks like it's control or
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|)
475 if (not length $paragraph) {
476 print {$debug} "Found control/pseudo-headers and skiping them\n";
477 $in_pseudoheaders = 1;
481 next if $in_pseudoheaders;
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";
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";
498 $action = "Summary recorded from message bug $param{bug} message $summary_msg";
501 $data->{summary} = $summary;
502 append_action_to_log(bug => $data->{bug_num},
504 __return_append_to_log_options(
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},
517 for (1..$locks) { unfilelock(); }
525 =head1 OWNER FUNCTIONS
531 transcript => $transcript,
532 ($dl > 0 ? (debug => $transcript):()),
533 requester => $header{from},
534 request_addr => $controlrequestaddr,
536 recipients => \%recipients,
542 print {$transcript} "Failed to mark $ref as having an owner: $@";
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.
551 my %param = validate_with(params => \@_,
552 spec => {bug => {type => SCALAR,
555 owner => {type => SCALAR|UNDEF,
558 %append_action_options,
563 local $SIG{__DIE__} = sub {
565 for (1..$locks) { unfilelock(); }
569 my ($debug,$transcript) = __handle_debug_transcript(%param);
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}
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}) {
584 $action = "Removed annotation that $config{bug} was owned by " .
588 if (length $data->{owner}) {
589 $action = "Owner changed from $data->{owner} to $param{owner}.";
592 $action = "Owner recorded as $param{owner}."
595 $data->{owner} = $param{owner};
596 append_action_to_log(bug => $data->{bug_num},
598 __return_append_to_log_options(
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},
611 for (1..$locks) { unfilelock(); }
616 =head1 ARCHIVE FUNCTIONS
623 bug_archive(bug => $bug_num,
625 transcript => \$transcript,
630 transcript("Unable to archive $bug_num\n");
633 transcript($transcript);
636 This routine archives a bug
640 =item bug -- bug number
642 =item check_archiveable -- check wether a bug is archiveable before
643 archiving; defaults to 1
645 =item archive_unarchived -- whether to archive bugs which have not
646 previously been archived; defaults to 1. [Set to 0 when used from
649 =item ignore_time -- whether to ignore time constraints when archiving
650 a bug; defaults to 0.
657 my %param = validate_with(params => \@_,
658 spec => {bug => {type => SCALAR,
661 check_archiveable => {type => BOOLEAN,
664 archive_unarchived => {type => BOOLEAN,
667 ignore_time => {type => BOOLEAN,
671 %append_action_options,
676 local $SIG{__DIE__} = sub {
678 for (1..$locks) { unfilelock(); }
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},
688 print {$transcript} "Bug $param{bug} cannot be archived\n";
689 die "Bug $param{bug} cannot be archived";
691 print {$debug} "$param{bug} considering\n";
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";
700 if (not $param{archive_unarchived} and
701 not exists $data[0]{unarchived}
703 print {$transcript} "$param{bug} has not been archived previously\n";
704 die "$param{bug} has not been archived previously";
706 add_recipients(recipients => $param{recipients},
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},
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,
727 __return_append_to_log_options(
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" );
741 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
743 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
744 print {$transcript} "deleted $bug (from $param{bug})\n";
746 bughook_archive(@bugs);
747 if (exists $param{bugs_affected}) {
748 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
750 print {$debug} "$param{bug} unlocking $locks\n";
752 for (1..$locks) { unfilelock(); }
754 print {$debug} "$param{bug} unlocking done\n";
761 bug_unarchive(bug => $bug_num,
763 transcript => \$transcript,
768 transcript("Unable to archive bug: $bug_num");
770 transcript($transcript);
772 This routine unarchives a bug
777 my %param = validate_with(params => \@_,
778 spec => {bug => {type => SCALAR,
782 %append_action_options,
786 local $SIG{__DIE__} = sub {
788 for (1..$locks) { unfilelock(); }
792 my $action = "$config{bug} unarchived.";
793 my ($debug,$transcript) = __handle_debug_transcript(%param);
794 print {$debug} "$param{bug} considering\n";
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}";
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";
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) {
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";
820 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
821 print {$transcript} "Unarchived $config{bug} $bug\n";
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!";
831 $newdata->{unarchived} = time;
832 append_action_to_log(bug => $bug,
834 __return_append_to_log_options(
839 if not exists $param{append_log} or $param{append_log};
840 writebug($bug,$newdata);
841 add_recipients(recipients => $param{recipients},
845 print {$debug} "$param{bug} unlocking $locks\n";
847 for (1..$locks) { unfilelock(); };
849 if (exists $param{bugs_affected}) {
850 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
852 print {$debug} "$param{bug} unlocking done\n";
855 =head2 append_action_to_log
859 This should probably be moved to Debbugs::Log; have to think that out
864 sub append_action_to_log{
865 my %param = validate_with(params => \@_,
866 spec => {bug => {type => SCALAR,
869 action => {type => SCALAR,
871 requester => {type => SCALAR,
873 request_addr => {type => SCALAR,
875 location => {type => SCALAR,
878 message => {type => SCALAR|ARRAYREF,
880 get_lock => {type => BOOLEAN,
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}");
892 my $log = IO::File->new(">>$log_location") or
893 die "Unable to open $log_location for appending: $!";
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".
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}) {
911 =head1 PRIVATE FUNCTIONS
913 =head2 __handle_affected_packages
915 __handle_affected_packages(affected_packages => {},
923 sub __handle_affected_packages{
924 my %param = validate_with(params => \@_,
925 spec => {%common_options,
926 data => {type => ARRAYREF|HASHREF
931 for my $data (make_list($param{data})) {
932 $param{affected_packages}{$data->{package}} = 1;
936 =head2 __handle_debug_transcript
938 my ($debug,$transcript) = __handle_debug_transcript(%param);
940 Returns a debug and transcript filehandle
945 sub __handle_debug_transcript{
946 my %param = validate_with(params => \@_,
947 spec => {%common_options},
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);
959 Produces a small bit of bug information to kick out to the transcript
966 $return .= "Bug ".($data->{bug_num}||'').
967 " [".($data->{package}||''). "] ".
968 ($data->{subject}||'')."\n";
974 sub __return_append_to_log_options{
976 my $action = $param{action} if exists $param{action};
977 if (not exists $param{requester}) {
978 $param{requester} = $config{control_internal_requester};
980 if (not exists $param{request_addr}) {
981 $param{request_addr} = $config{control_internal_request_addr};
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},
993 if (not defined $action) {
994 carp "Undefined action!";
995 $action = "unknown action";
997 return (action => $action,
998 (map {exists $append_action_options{$_}?($_,$param{$_}):()}