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 # transcript => $transcript,
214 # for my $data (@data) {
215 # append_action_to_log(bug => $data->{bug_num},
217 # __return_append_to_log_options(
222 # if not exists $param{append_log} or $param{append_log};
223 # writebug($data->{bug_num},$data);
224 # print {$transcript} "$action\n";
225 # add_recipients(data => $data,
226 # recipients => $param{recipients},
228 # transcript => $transcript,
232 # for (1..$locks) { unfilelock(); }
241 transcript => $transcript,
242 ($dl > 0 ? (debug => $transcript):()),
243 requester => $header{from},
244 request_addr => $controlrequestaddr,
246 affected_packages => \%affected_packages,
247 recipients => \%recipients,
255 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
258 This marks a bug as affecting packages which the bug is not actually
259 in. This should only be used in cases where fixing the bug instantly
260 resolves the problem in the other packages.
262 By default, the packages are set to the list of packages passed.
263 However, if you pass add => 1 or remove => 1, the list of packages
264 passed are added or removed from the affects list, respectively.
269 my %param = validate_with(params => \@_,
270 spec => {bug => {type => SCALAR,
273 # specific options here
274 packages => {type => SCALAR|ARRAYREF,
277 add => {type => BOOLEAN,
280 remove => {type => BOOLEAN,
284 %append_action_options,
287 if ($param{add} and $param{remove}) {
288 croak "Asking to both add and remove affects is nonsensical";
292 local $SIG{__DIE__} = sub {
294 for (1..$locks) { unfilelock(); }
298 my ($debug,$transcript) = __handle_debug_transcript(%param);
300 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
301 __handle_affected_packages(data => \@data,%param);
302 print {$transcript} __bug_info(@data);
303 add_recipients(data => \@data,
304 recipients => $param{recipients},
306 transcript => $transcript,
308 my $action = 'Did not alter affected packages';
309 for my $data (@data) {
310 print {$debug} "Going to change affects\n";
311 my @packages = splitpackages($data->{affects});
313 @packages{@packages} = (1) x @packages;
316 for my $package (make_list($param{packages})) {
317 if (not $packages{$package}) {
318 $packages{$package} = 1;
319 push @added,$package;
323 $action = "Added indication that $data->{bug_num} affects ".
324 english_join(', ',' and ',@added);
327 elsif ($param{remove}) {
329 for my $package (make_list($param{packages})) {
330 if ($packages{$package}) {
331 delete $packages{$package};
332 push @removed,$package;
335 $action = "Removed indication that $data->{bug_num} affects " .
336 english_join(', ',' and ',@removed);
340 for my $package (make_list($param{packages})) {
341 $packages{$package} = 1;
343 $action = "Noted that $data->{bug_num} affects ".
344 english_join(', ',' and ', keys %packages);
346 $data->{affects} = join(',',keys %packages);
347 append_action_to_log(bug => $data->{bug_num},
349 __return_append_to_log_options(
354 if not exists $param{append_log} or $param{append_log};
355 writebug($data->{bug_num},$data);
356 print {$transcript} "$action\n";
357 add_recipients(data => $data,
358 recipients => $param{recipients},
360 transcript => $transcript,
364 for (1..$locks) { unfilelock(); }
370 =head1 SUMMARY FUNCTIONS
376 transcript => $transcript,
377 ($dl > 0 ? (debug => $transcript):()),
378 requester => $header{from},
379 request_addr => $controlrequestaddr,
381 affected_packages => \%affected_packages,
382 recipients => \%recipients,
388 print {$transcript} "Failed to mark $ref with summary foo: $@";
391 Handles all setting of summary fields
393 If summary is undef, unsets the summary
395 If summary is 0, sets the summary to the first paragraph contained in
398 If summary is numeric, sets the summary to the message specified.
405 my %param = validate_with(params => \@_,
406 spec => {bug => {type => SCALAR,
409 # specific options here
410 summary => {type => SCALAR|UNDEF,
414 %append_action_options,
417 croak "summary must be numeric or undef" if
418 defined $param{summary} and not $param{summary} =~ /^\d+$/;
421 local $SIG{__DIE__} = sub {
423 for (1..$locks) { unfilelock(); }
427 my ($debug,$transcript) = __handle_debug_transcript(%param);
429 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
430 __handle_affected_packages(data => \@data,%param);
431 print {$transcript} __bug_info(@data);
432 add_recipients(data => \@data,
433 recipients => $param{recipients},
435 transcript => $transcript,
437 # figure out the log that we're going to use
439 my $summary_msg = '';
441 if (not defined $param{summary}) {
443 print {$debug} "Removing summary fields";
444 $action = 'Removed summary';
448 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
449 if ($param{summary} == 0) {
450 $log = $param{message};
451 $summary_msg = @records + 1;
454 if (($param{summary} - 1 ) > $#records) {
455 die "Message number '$param{summary}' exceeds the maximum message '$#records'";
457 my $record = $records[($param{summary} - 1 )];
458 if ($record->{type} !~ /incoming-recv|recips/) {
459 die "Message number '$param{summary}' is a invalid message type '$record->{type}'";
461 $summary_msg = $param{summary};
462 $log = [$record->{text}];
464 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
465 my $body = $p_o->{body};
466 my $in_pseudoheaders = 0;
468 # walk through body until we get non-blank lines
469 for my $line (@{$body}) {
470 if ($line =~ /^\s*$/) {
471 if (length $paragraph) {
472 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
478 $in_pseudoheaders = 0;
481 # skip a paragraph if it looks like it's control or
483 if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
484 (?:package|(?:no|)owner|severity|tag|summary| #control
485 reopen|close|(?:not|)(?:fixed|found)|clone|
486 (?:force|)merge|user(?:category|tag|)
489 if (not length $paragraph) {
490 print {$debug} "Found control/pseudo-headers and skiping them\n";
491 $in_pseudoheaders = 1;
495 next if $in_pseudoheaders;
496 $paragraph .= $line ." \n";
498 print {$debug} "Summary is going to be '$paragraph'\n";
499 $summary = $paragraph;
500 $summary =~ s/[\n\r]//g;
501 if (not length $summary) {
502 die "Unable to find summary message to use";
504 # trim off a trailing space
507 for my $data (@data) {
508 print {$debug} "Going to change summary";
509 if (length $summary) {
510 if (length $data->{summary}) {
511 $action = "Summary replaced with message bug $param{bug} message $summary_msg";
514 $action = "Summary recorded from message bug $param{bug} message $summary_msg";
517 $data->{summary} = $summary;
518 append_action_to_log(bug => $data->{bug_num},
520 __return_append_to_log_options(
525 if not exists $param{append_log} or $param{append_log};
526 writebug($data->{bug_num},$data);
527 print {$transcript} "$action\n";
528 add_recipients(data => $data,
529 recipients => $param{recipients},
531 transcript => $transcript,
535 for (1..$locks) { unfilelock(); }
543 =head1 OWNER FUNCTIONS
549 transcript => $transcript,
550 ($dl > 0 ? (debug => $transcript):()),
551 requester => $header{from},
552 request_addr => $controlrequestaddr,
554 recipients => \%recipients,
560 print {$transcript} "Failed to mark $ref as having an owner: $@";
563 Handles all setting of the owner field; given an owner of undef or of
564 no length, indicates that a bug is not owned by anyone.
569 my %param = validate_with(params => \@_,
570 spec => {bug => {type => SCALAR,
573 owner => {type => SCALAR|UNDEF,
576 %append_action_options,
581 local $SIG{__DIE__} = sub {
583 for (1..$locks) { unfilelock(); }
587 my ($debug,$transcript) = __handle_debug_transcript(%param);
589 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
590 __handle_affected_packages(data => \@data,%param);
591 print {$transcript} __bug_info(@data);
592 @data and defined $data[0] or die "No bug found for $param{bug}";
593 add_recipients(data => \@data,
594 recipients => $param{recipients},
596 transcript => $transcript,
599 for my $data (@data) {
600 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
601 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
602 if (not defined $param{owner} or not length $param{owner}) {
604 $action = "Removed annotation that $config{bug} was owned by " .
608 if (length $data->{owner}) {
609 $action = "Owner changed from $data->{owner} to $param{owner}.";
612 $action = "Owner recorded as $param{owner}."
615 $data->{owner} = $param{owner};
616 append_action_to_log(bug => $data->{bug_num},
618 __return_append_to_log_options(
623 if not exists $param{append_log} or $param{append_log};
624 writebug($data->{bug_num},$data);
625 print {$transcript} "$action\n";
626 add_recipients(data => $data,
627 recipients => $param{recipients},
629 transcript => $transcript,
633 for (1..$locks) { unfilelock(); }
638 =head1 ARCHIVE FUNCTIONS
645 bug_archive(bug => $bug_num,
647 transcript => \$transcript,
652 transcript("Unable to archive $bug_num\n");
655 transcript($transcript);
658 This routine archives a bug
662 =item bug -- bug number
664 =item check_archiveable -- check wether a bug is archiveable before
665 archiving; defaults to 1
667 =item archive_unarchived -- whether to archive bugs which have not
668 previously been archived; defaults to 1. [Set to 0 when used from
671 =item ignore_time -- whether to ignore time constraints when archiving
672 a bug; defaults to 0.
679 my %param = validate_with(params => \@_,
680 spec => {bug => {type => SCALAR,
683 check_archiveable => {type => BOOLEAN,
686 archive_unarchived => {type => BOOLEAN,
689 ignore_time => {type => BOOLEAN,
693 %append_action_options,
698 local $SIG{__DIE__} = sub {
700 for (1..$locks) { unfilelock(); }
704 my $action = "$config{bug} archived.";
705 my ($debug,$transcript) = __handle_debug_transcript(%param);
706 if ($param{check_archiveable} and
707 not bug_archiveable(bug=>$param{bug},
708 ignore_time => $param{ignore_time},
710 print {$transcript} "Bug $param{bug} cannot be archived\n";
711 die "Bug $param{bug} cannot be archived";
713 print {$debug} "$param{bug} considering\n";
715 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
716 __handle_affected_packages(data => \@data,%param);
717 print {$transcript} __bug_info(@data);
718 print {$debug} "$param{bug} read $locks\n";
719 @data and defined $data[0] or die "No bug found for $param{bug}";
720 print {$debug} "$param{bug} read done\n";
722 if (not $param{archive_unarchived} and
723 not exists $data[0]{unarchived}
725 print {$transcript} "$param{bug} has not been archived previously\n";
726 die "$param{bug} has not been archived previously";
728 add_recipients(recipients => $param{recipients},
731 transcript => $transcript,
733 my @bugs = map {$_->{bug_num}} @data;
734 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
735 for my $bug (@bugs) {
736 if ($param{check_archiveable}) {
737 die "Bug $bug cannot be archived (but $param{bug} can?)"
738 unless bug_archiveable(bug=>$bug,
739 ignore_time => $param{ignore_time},
743 # If we get here, we can archive/remove this bug
744 print {$debug} "$param{bug} removing\n";
745 for my $bug (@bugs) {
746 #print "$param{bug} removing $bug\n" if $debug;
747 my $dir = get_hashname($bug);
748 # First indicate that this bug is being archived
749 append_action_to_log(bug => $bug,
751 __return_append_to_log_options(
756 if not exists $param{append_log} or $param{append_log};
757 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
758 if ($config{save_old_bugs}) {
759 mkpath("$config{spool_dir}/archive/$dir");
760 foreach my $file (@files_to_remove) {
761 link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
762 copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
765 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
767 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
768 print {$transcript} "deleted $bug (from $param{bug})\n";
770 bughook_archive(@bugs);
771 if (exists $param{bugs_affected}) {
772 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
774 print {$debug} "$param{bug} unlocking $locks\n";
776 for (1..$locks) { unfilelock(); }
778 print {$debug} "$param{bug} unlocking done\n";
785 bug_unarchive(bug => $bug_num,
787 transcript => \$transcript,
792 transcript("Unable to archive bug: $bug_num");
794 transcript($transcript);
796 This routine unarchives a bug
801 my %param = validate_with(params => \@_,
802 spec => {bug => {type => SCALAR,
806 %append_action_options,
810 local $SIG{__DIE__} = sub {
812 for (1..$locks) { unfilelock(); }
816 my $action = "$config{bug} unarchived.";
817 my ($debug,$transcript) = __handle_debug_transcript(%param);
818 print {$debug} "$param{bug} considering\n";
820 ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
821 __handle_affected_packages(data => \@data,%param);
822 print {$transcript} __bug_info(@data);
823 print {$debug} "$param{bug} read $locks\n";
824 if (not @data or not defined $data[0]) {
825 print {$transcript} "No bug found for $param{bug}\n";
826 die "No bug found for $param{bug}";
828 print {$debug} "$param{bug} read done\n";
829 my @bugs = map {$_->{bug_num}} @data;
830 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
831 print {$debug} "$param{bug} unarchiving\n";
833 for my $bug (@bugs) {
834 print {$debug} "$param{bug} removing $bug\n";
835 my $dir = get_hashname($bug);
836 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
837 mkpath("archive/$dir");
838 foreach my $file (@files_to_copy) {
840 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
841 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
842 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
844 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
845 print {$transcript} "Unarchived $config{bug} $bug\n";
847 unlink(@files_to_remove) or die "Unable to unlink bugs";
848 # Indicate that this bug has been archived previously
849 for my $bug (@bugs) {
850 my $newdata = readbug($bug);
851 if (not defined $newdata) {
852 print {$transcript} "$config{bug} $bug disappeared!\n";
853 die "Bug $bug disappeared!";
855 $newdata->{unarchived} = time;
856 append_action_to_log(bug => $bug,
858 __return_append_to_log_options(
863 if not exists $param{append_log} or $param{append_log};
864 writebug($bug,$newdata);
865 add_recipients(recipients => $param{recipients},
868 transcript => $transcript,
871 print {$debug} "$param{bug} unlocking $locks\n";
873 for (1..$locks) { unfilelock(); };
875 if (exists $param{bugs_affected}) {
876 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
878 print {$debug} "$param{bug} unlocking done\n";
881 =head2 append_action_to_log
885 This should probably be moved to Debbugs::Log; have to think that out
890 sub append_action_to_log{
891 my %param = validate_with(params => \@_,
892 spec => {bug => {type => SCALAR,
895 action => {type => SCALAR,
897 requester => {type => SCALAR,
900 request_addr => {type => SCALAR,
903 location => {type => SCALAR,
906 message => {type => SCALAR|ARRAYREF,
909 desc => {type => SCALAR,
912 get_lock => {type => BOOLEAN,
917 # Fix this to use $param{location}
918 my $log_location = buglog($param{bug});
919 die "Unable to find .log for $param{bug}"
920 if not defined $log_location;
921 if ($param{get_lock}) {
922 filelock("lock/$param{bug}");
924 my $log = IO::File->new(">>$log_location") or
925 die "Unable to open $log_location for appending: $!";
927 "<!-- time:".time." -->\n".
928 "<strong>".html_escape($param{action})."</strong>\n";
929 if (length $param{requester}) {
930 $msg .= "Request was from <code>".html_escape($param{requester})."</code>\n";
932 if (length $param{request_addr}) {
933 $msg .= "to <code>".html_escape($param{request_addr})."</code>";
935 if (length $param{desc}) {
936 $msg .= ":<br>\n$param{desc}\n";
942 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
943 $msg .= "\7\n".join('',escape_log(make_list($param{message})))."\n\3\n"
944 or die "Unable to append to $log_location: $!";
946 print {$log} $msg or die "Unable to append to $log_location: $!";
947 close $log or die "Unable to close $log_location: $!";
948 if ($param{get_lock}) {
956 =head1 PRIVATE FUNCTIONS
958 =head2 __handle_affected_packages
960 __handle_affected_packages(affected_packages => {},
968 sub __handle_affected_packages{
969 my %param = validate_with(params => \@_,
970 spec => {%common_options,
971 data => {type => ARRAYREF|HASHREF
976 for my $data (make_list($param{data})) {
977 $param{affected_packages}{$data->{package}} = 1;
981 =head2 __handle_debug_transcript
983 my ($debug,$transcript) = __handle_debug_transcript(%param);
985 Returns a debug and transcript filehandle
990 sub __handle_debug_transcript{
991 my %param = validate_with(params => \@_,
992 spec => {%common_options},
995 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
996 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
997 return ($debug,$transcript);
1004 Produces a small bit of bug information to kick out to the transcript
1011 $return .= "Bug ".($data->{bug_num}||'').
1012 " [".($data->{package}||''). "] ".
1013 ($data->{subject}||'')."\n";
1019 sub __return_append_to_log_options{
1021 my $action = $param{action} if exists $param{action};
1022 if (not exists $param{requester}) {
1023 $param{requester} = $config{control_internal_requester};
1025 if (not exists $param{request_addr}) {
1026 $param{request_addr} = $config{control_internal_request_addr};
1028 if (not exists $param{message}) {
1029 my $date = rfc822_date();
1030 $param{message} = fill_in_template(template => 'mail/fake_control_message',
1031 variables => {request_addr => $param{request_addr},
1032 requester => $param{requester},
1038 if (not defined $action) {
1039 carp "Undefined action!";
1040 $action = "unknown action";
1042 return (action => $action,
1043 (map {exists $append_action_options{$_}?($_,$param{$_}):()}