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) {
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) {
474 $in_pseudoheaders = 0;
477 # skip a paragraph if it looks like it's control or
479 if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
480 (?:package|(?:no|)owner|severity|tag|summary| #control
481 reopen|close|(?:not|)(?:fixed|found)|clone|
482 (?:force|)merge|user(?:category|tag|)
485 if (not length $paragraph) {
486 print {$debug} "Found control/pseudo-headers and skiping them\n";
487 $in_pseudoheaders = 1;
491 next if $in_pseudoheaders;
494 print {$debug} "Summary is going to be '$paragraph'\n";
495 $summary = $paragraph;
496 $summary =~ s/[\n\r]//g;
497 if (not length $summary) {
498 die "Unable to find summary message to use";
501 for my $data (@data) {
502 print {$debug} "Going to change summary";
503 if (length $summary) {
504 if (length $data->{summary}) {
505 $action = "Summary replaced with message bug $param{bug} message $summary_msg";
508 $action = "Summary recorded from message bug $param{bug} message $summary_msg";
511 $data->{summary} = $summary;
512 append_action_to_log(bug => $data->{bug_num},
514 __return_append_to_log_options(
519 if not exists $param{append_log} or $param{append_log};
520 writebug($data->{bug_num},$data);
521 print {$transcript} "$action\n";
522 add_recipients(data => $data,
523 recipients => $param{recipients},
525 transcript => $transcript,
529 for (1..$locks) { unfilelock(); }
537 =head1 OWNER FUNCTIONS
543 transcript => $transcript,
544 ($dl > 0 ? (debug => $transcript):()),
545 requester => $header{from},
546 request_addr => $controlrequestaddr,
548 recipients => \%recipients,
554 print {$transcript} "Failed to mark $ref as having an owner: $@";
557 Handles all setting of the owner field; given an owner of undef or of
558 no length, indicates that a bug is not owned by anyone.
563 my %param = validate_with(params => \@_,
564 spec => {bug => {type => SCALAR,
567 owner => {type => SCALAR|UNDEF,
570 %append_action_options,
575 local $SIG{__DIE__} = sub {
577 for (1..$locks) { unfilelock(); }
581 my ($debug,$transcript) = __handle_debug_transcript(%param);
583 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
584 __handle_affected_packages(data => \@data,%param);
585 print {$transcript} __bug_info(@data);
586 @data and defined $data[0] or die "No bug found for $param{bug}";
587 add_recipients(data => \@data,
588 recipients => $param{recipients},
590 transcript => $transcript,
593 for my $data (@data) {
594 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
595 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
596 if (not defined $param{owner} or not length $param{owner}) {
598 $action = "Removed annotation that $config{bug} was owned by " .
602 if (length $data->{owner}) {
603 $action = "Owner changed from $data->{owner} to $param{owner}.";
606 $action = "Owner recorded as $param{owner}."
609 $data->{owner} = $param{owner};
610 append_action_to_log(bug => $data->{bug_num},
612 __return_append_to_log_options(
617 if not exists $param{append_log} or $param{append_log};
618 writebug($data->{bug_num},$data);
619 print {$transcript} "$action\n";
620 add_recipients(data => $data,
621 recipients => $param{recipients},
623 transcript => $transcript,
627 for (1..$locks) { unfilelock(); }
632 =head1 ARCHIVE FUNCTIONS
639 bug_archive(bug => $bug_num,
641 transcript => \$transcript,
646 transcript("Unable to archive $bug_num\n");
649 transcript($transcript);
652 This routine archives a bug
656 =item bug -- bug number
658 =item check_archiveable -- check wether a bug is archiveable before
659 archiving; defaults to 1
661 =item archive_unarchived -- whether to archive bugs which have not
662 previously been archived; defaults to 1. [Set to 0 when used from
665 =item ignore_time -- whether to ignore time constraints when archiving
666 a bug; defaults to 0.
673 my %param = validate_with(params => \@_,
674 spec => {bug => {type => SCALAR,
677 check_archiveable => {type => BOOLEAN,
680 archive_unarchived => {type => BOOLEAN,
683 ignore_time => {type => BOOLEAN,
687 %append_action_options,
692 local $SIG{__DIE__} = sub {
694 for (1..$locks) { unfilelock(); }
698 my $action = "$config{bug} archived.";
699 my ($debug,$transcript) = __handle_debug_transcript(%param);
700 if ($param{check_archiveable} and
701 not bug_archiveable(bug=>$param{bug},
702 ignore_time => $param{ignore_time},
704 print {$transcript} "Bug $param{bug} cannot be archived\n";
705 die "Bug $param{bug} cannot be archived";
707 print {$debug} "$param{bug} considering\n";
709 ($locks, @data) = lock_read_all_merged_bugs($param{bug});
710 __handle_affected_packages(data => \@data,%param);
711 print {$transcript} __bug_info(@data);
712 print {$debug} "$param{bug} read $locks\n";
713 @data and defined $data[0] or die "No bug found for $param{bug}";
714 print {$debug} "$param{bug} read done\n";
716 if (not $param{archive_unarchived} and
717 not exists $data[0]{unarchived}
719 print {$transcript} "$param{bug} has not been archived previously\n";
720 die "$param{bug} has not been archived previously";
722 add_recipients(recipients => $param{recipients},
725 transcript => $transcript,
727 my @bugs = map {$_->{bug_num}} @data;
728 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
729 for my $bug (@bugs) {
730 if ($param{check_archiveable}) {
731 die "Bug $bug cannot be archived (but $param{bug} can?)"
732 unless bug_archiveable(bug=>$bug,
733 ignore_time => $param{ignore_time},
737 # If we get here, we can archive/remove this bug
738 print {$debug} "$param{bug} removing\n";
739 for my $bug (@bugs) {
740 #print "$param{bug} removing $bug\n" if $debug;
741 my $dir = get_hashname($bug);
742 # First indicate that this bug is being archived
743 append_action_to_log(bug => $bug,
745 __return_append_to_log_options(
750 if not exists $param{append_log} or $param{append_log};
751 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
752 if ($config{save_old_bugs}) {
753 mkpath("$config{spool_dir}/archive/$dir");
754 foreach my $file (@files_to_remove) {
755 link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or
756 copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" );
759 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
761 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
762 print {$transcript} "deleted $bug (from $param{bug})\n";
764 bughook_archive(@bugs);
765 if (exists $param{bugs_affected}) {
766 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
768 print {$debug} "$param{bug} unlocking $locks\n";
770 for (1..$locks) { unfilelock(); }
772 print {$debug} "$param{bug} unlocking done\n";
779 bug_unarchive(bug => $bug_num,
781 transcript => \$transcript,
786 transcript("Unable to archive bug: $bug_num");
788 transcript($transcript);
790 This routine unarchives a bug
795 my %param = validate_with(params => \@_,
796 spec => {bug => {type => SCALAR,
800 %append_action_options,
804 local $SIG{__DIE__} = sub {
806 for (1..$locks) { unfilelock(); }
810 my $action = "$config{bug} unarchived.";
811 my ($debug,$transcript) = __handle_debug_transcript(%param);
812 print {$debug} "$param{bug} considering\n";
814 ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive');
815 __handle_affected_packages(data => \@data,%param);
816 print {$transcript} __bug_info(@data);
817 print {$debug} "$param{bug} read $locks\n";
818 if (not @data or not defined $data[0]) {
819 print {$transcript} "No bug found for $param{bug}\n";
820 die "No bug found for $param{bug}";
822 print {$debug} "$param{bug} read done\n";
823 my @bugs = map {$_->{bug_num}} @data;
824 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
825 print {$debug} "$param{bug} unarchiving\n";
827 for my $bug (@bugs) {
828 print {$debug} "$param{bug} removing $bug\n";
829 my $dir = get_hashname($bug);
830 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
831 mkpath("archive/$dir");
832 foreach my $file (@files_to_copy) {
834 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
835 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
836 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
838 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
839 print {$transcript} "Unarchived $config{bug} $bug\n";
841 unlink(@files_to_remove) or die "Unable to unlink bugs";
842 # Indicate that this bug has been archived previously
843 for my $bug (@bugs) {
844 my $newdata = readbug($bug);
845 if (not defined $newdata) {
846 print {$transcript} "$config{bug} $bug disappeared!\n";
847 die "Bug $bug disappeared!";
849 $newdata->{unarchived} = time;
850 append_action_to_log(bug => $bug,
852 __return_append_to_log_options(
857 if not exists $param{append_log} or $param{append_log};
858 writebug($bug,$newdata);
859 add_recipients(recipients => $param{recipients},
862 transcript => $transcript,
865 print {$debug} "$param{bug} unlocking $locks\n";
867 for (1..$locks) { unfilelock(); };
869 if (exists $param{bugs_affected}) {
870 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
872 print {$debug} "$param{bug} unlocking done\n";
875 =head2 append_action_to_log
879 This should probably be moved to Debbugs::Log; have to think that out
884 sub append_action_to_log{
885 my %param = validate_with(params => \@_,
886 spec => {bug => {type => SCALAR,
889 action => {type => SCALAR,
891 requester => {type => SCALAR,
893 request_addr => {type => SCALAR,
895 location => {type => SCALAR,
898 message => {type => SCALAR|ARRAYREF,
900 get_lock => {type => BOOLEAN,
905 # Fix this to use $param{location}
906 my $log_location = buglog($param{bug});
907 die "Unable to find .log for $param{bug}"
908 if not defined $log_location;
909 if ($param{get_lock}) {
910 filelock("lock/$param{bug}");
912 my $log = IO::File->new(">>$log_location") or
913 die "Unable to open $log_location for appending: $!";
915 "<!-- time:".time." -->\n".
916 "<strong>".html_escape($param{action})."</strong>\n".
917 "Request was from <code>".html_escape($param{requester})."</code>\n".
918 "to <code>".html_escape($param{request_addr})."</code>. \n".
920 "\7\n",escape_log(make_list($param{message})),"\n\3\n"
921 or die "Unable to append to $log_location: $!";
922 close $log or die "Unable to close $log_location: $!";
923 if ($param{get_lock}) {
931 =head1 PRIVATE FUNCTIONS
933 =head2 __handle_affected_packages
935 __handle_affected_packages(affected_packages => {},
943 sub __handle_affected_packages{
944 my %param = validate_with(params => \@_,
945 spec => {%common_options,
946 data => {type => ARRAYREF|HASHREF
951 for my $data (make_list($param{data})) {
952 $param{affected_packages}{$data->{package}} = 1;
956 =head2 __handle_debug_transcript
958 my ($debug,$transcript) = __handle_debug_transcript(%param);
960 Returns a debug and transcript filehandle
965 sub __handle_debug_transcript{
966 my %param = validate_with(params => \@_,
967 spec => {%common_options},
970 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
971 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
972 return ($debug,$transcript);
979 Produces a small bit of bug information to kick out to the transcript
986 $return .= "Bug ".($data->{bug_num}||'').
987 " [".($data->{package}||''). "] ".
988 ($data->{subject}||'')."\n";
994 sub __return_append_to_log_options{
996 my $action = $param{action} if exists $param{action};
997 if (not exists $param{requester}) {
998 $param{requester} = $config{control_internal_requester};
1000 if (not exists $param{request_addr}) {
1001 $param{request_addr} = $config{control_internal_request_addr};
1003 if (not exists $param{message}) {
1004 my $date = rfc822_date();
1005 $param{message} = fill_in_template(template => 'mail/fake_control_message',
1006 variables => {request_addr => $param{request_addr},
1007 requester => $param{requester},
1013 if (not defined $action) {
1014 carp "Undefined action!";
1015 $action = "unknown action";
1017 return (action => $action,
1018 (map {exists $append_action_options{$_}?($_,$param{$_}):()}