X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl.pm;h=1f8b3aac60d3cb98fe5264795fc7806e795c4bac;hb=6532b246361b5d28b6ce3b44154a71edd3ca9a9e;hp=39e6648bbe8478aea8e28b07e454007f0c8f4e3d;hpb=b589eb07e8c620e6daa2ac0dcd65f7d68f242814;p=debbugs.git
diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index 39e6648..1f8b3aa 100644
--- a/Debbugs/Control.pm
+++ b/Debbugs/Control.pm
@@ -75,7 +75,7 @@ is true, the above options must be present, and their values are used.
use warnings;
use strict;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
BEGIN{
$VERSION = 1.00;
@@ -110,7 +110,8 @@ BEGIN{
}
use Debbugs::Config qw(:config);
-use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
+use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
+use Debbugs::UTF8;
use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
use Debbugs::CGI qw(html_escape);
use Debbugs::Log qw(:misc :write);
@@ -125,7 +126,7 @@ use IO::File;
use Debbugs::Text qw(:templates);
-use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
+use Debbugs::Mail qw(rfc822_date send_mail_message default_headers encode_headers);
use Debbugs::MIME qw(create_mime_message);
use Mail::RFC822::Address qw();
@@ -133,7 +134,7 @@ use Mail::RFC822::Address qw();
use POSIX qw(strftime);
use Storable qw(dclone nfreeze);
-use List::Util qw(first max);
+use List::AllUtils qw(first max);
use Encode qw(encode_utf8);
use Carp;
@@ -363,7 +364,7 @@ sub set_blocks {
next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
my $data = read_bug(bug=>$blocker,
);
- if (defined $data and not $data->{archive}) {
+ if (defined $data and not $data->{archived}) {
$data = split_status_fields($data);
$ok_blockers{$blocker} = 1;
my @merged_bugs;
@@ -378,15 +379,17 @@ sub set_blocks {
# throw an error if we are setting the blockers and there is a bad
# blocker
if (keys %bad_blockers and $mode eq 'set') {
- croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
- keys %ok_blockers?'':" and no known blocking bug(s)";
+ __end_control(%info);
+ croak "Unknown/archived blocking bug(s):".join(', ',keys %bad_blockers).
+ keys %ok_blockers?'':" and no good blocking bug(s)";
}
# if there are no ok blockers and we are not setting the blockers,
# there's an error.
if (not keys %ok_blockers and $mode ne 'set') {
print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
if (keys %bad_blockers) {
- croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
+ __end_control(%info);
+ croak "Unknown/archived blocking bug(s):".join(', ',keys %bad_blockers);
}
__end_control(%info);
return;
@@ -409,6 +412,7 @@ sub set_blocks {
@bugs{@bugs} = (1) x @bugs;
for my $blocker (@change_blockers) {
if ($bugs{$blocker}) {
+ __end_control(%info);
croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
}
}
@@ -443,7 +447,6 @@ sub set_blocks {
}
}
}
- my @new_blockers = keys %blockers;
for my $data (@data) {
my $old_data = dclone($data);
# remove blockers and/or add new ones as appropriate
@@ -486,9 +489,7 @@ sub set_blocks {
$mungable_blocks{add} = \%added_blockers if keys %added_blockers;
my $new_locks = 0;
for my $add_remove (keys %mungable_blocks) {
- my @munge_blockers;
my %munge_blockers;
- my $block_locks = 0;
for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
next if $munge_blockers{$blocker};
my ($temp_locks, @blocking_data) =
@@ -627,10 +628,8 @@ sub set_tag {
__begin_control(%param,
command => 'tag'
);
- my ($debug,$transcript) =
- @info{qw(debug transcript)};
+ my $transcript = $info{transcript};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my @tags = make_list($param{tag});
if (not @tags and ($param{remove} or $param{add})) {
if ($param{remove}) {
@@ -648,11 +647,9 @@ sub set_tag {
my $action = 'Did not alter tags';
my %tag_added = ();
my %tag_removed = ();
- my %fixed_removed = ();
my @old_tags = split /\,?\s+/, $data->{keywords};
my %tags;
@tags{@old_tags} = (1) x @old_tags;
- my $reopened = 0;
my $old_data = dclone($data);
if (not $param{add} and not $param{remove}) {
$tag_removed{$_} = 1 for @old_tags;
@@ -772,10 +769,8 @@ sub set_severity {
__begin_control(%param,
command => 'severity'
);
- my ($debug,$transcript) =
- @info{qw(debug transcript)};
+ my $transcript = $info{transcript};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
@@ -877,10 +872,8 @@ sub set_done {
__begin_control(%param,
command => $param{reopen}?'reopen':'done',
);
- my ($debug,$transcript) =
- @info{qw(debug transcript)};
+ my $transcript = $info{transcript};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action ='';
if ($param{reopen}) {
@@ -940,7 +933,6 @@ sub set_done {
}
else {
my %submitter_notified;
- my $requester_notified = 0;
my $orig_report_set = 0;
for my $data (@data) {
if (exists $data->{done} and
@@ -1099,7 +1091,6 @@ sub set_submitter {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
# here we only concern ourselves with the first of the merged bugs
for my $data ($data[0]) {
@@ -1115,7 +1106,7 @@ sub set_submitter {
}
else {
if (defined $data->{originator} and length($data->{originator})) {
- $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
+ $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'.";
$notify_old_submitter = 1;
}
else {
@@ -1214,7 +1205,6 @@ sub set_forwarded {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
my $old_data = dclone($data);
@@ -1230,7 +1220,7 @@ sub set_forwarded {
$action= "Unset $config{bug} forwarded-to-address";
}
elsif (defined $data->{forwarded} and length($data->{forwarded})) {
- $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
+ $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
}
else {
$action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
@@ -1303,7 +1293,6 @@ sub set_title {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
my $old_data = dclone($data);
@@ -1315,7 +1304,7 @@ sub set_title {
}
else {
if (defined $data->{subject} and length($data->{subject})) {
- $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'";
+ $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'.";
} else {
$action= "Set $config{bug} title to '$param{title}'.";
}
@@ -1398,7 +1387,6 @@ sub set_package {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
# clean up the new package
my $new_package =
join(',',
@@ -1522,7 +1510,6 @@ sub set_found {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my %versions;
for my $version (make_list($param{found})) {
next unless defined $version;
@@ -1578,7 +1565,11 @@ sub set_found {
if (not @svers) {
@svers = $version;
}
- else {
+ elsif (not grep {$version eq $_} @svers) {
+ # The $version was not equal to one of the source
+ # versions, so it's probably unqualified (or just
+ # wrong). Delete it, and use the source versions
+ # instead.
if (exists $found_versions{$version}) {
delete $found_versions{$version};
$found_removed{$version} = 1;
@@ -1591,7 +1582,7 @@ sub set_found {
}
# if the found we are adding matches any fixed
# versions, remove them
- my @temp = grep m{(^|/)\Q$sver\E}, keys %fixed_versions;
+ my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
delete $fixed_versions{$_} for @temp;
$fixed_removed{$_} = 1 for @temp;
}
@@ -1615,7 +1606,7 @@ sub set_found {
# in the case of removal, we only concern ourself with
# the version passed, not the source version it maps
# to
- my @temp = grep m{(^|/)\Q$version\E}, keys %found_versions;
+ my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
delete $found_versions{$_} for @temp;
$found_removed{$_} = 1 for @temp;
}
@@ -1738,7 +1729,6 @@ sub set_fixed {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my %versions;
for my $version (make_list($param{fixed})) {
next unless defined $version;
@@ -1965,7 +1955,6 @@ sub set_merged {
return;
}
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my %data;
my %merged_bugs;
for my $data (@data) {
@@ -1976,7 +1965,6 @@ sub set_merged {
# handle unmerging
my $new_locks = 0;
if (not exists $param{merge_with}) {
- my $ok_to_unmerge = 1;
delete $merged_bugs{$param{bug}};
if (not keys %merged_bugs) {
print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
@@ -1990,8 +1978,11 @@ sub set_merged {
$data->{mergedwith} = '';
}
else {
- $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
- keys %merged_bugs);
+ $data->{mergedwith} =
+ join(' ',
+ sort {$a <=> $b}
+ grep {$_ != $data->{bug_num}}
+ keys %merged_bugs);
}
append_action_to_log(bug => $data->{bug_num},
command => 'merge',
@@ -2010,9 +2001,6 @@ sub set_merged {
return;
}
# lock and load all of the bugs we need
- my @bugs_to_load = keys %merging;
- my $bug_to_load;
- my %merge_added;
my ($data,$n_locks) =
__lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
data => \@data,
@@ -2085,9 +2073,11 @@ sub set_merged {
print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
}
if ($attempts > 0) {
+ __end_control(%info);
croak "Some bugs were altered while attempting to merge";
}
else {
+ __end_control(%info);
croak "Did not alter merged bugs";
}
}
@@ -2099,12 +2089,12 @@ sub set_merged {
$param{show_bug_info} and not __internal_request(1);
$bug_info_shown{$change_bug} = 1;
__allow_relocking($param{locks},[keys %data]);
+ eval {
for my $change (@{$changes->{$change_bug}}) {
if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
my %target_blockedby;
@target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
my %unhandled_targets = %target_blockedby;
- my @blocks_to_remove;
for my $key (split / /,$change->{orig_value}) {
delete $unhandled_targets{$key};
next if exists $target_blockedby{$key};
@@ -2136,6 +2126,12 @@ sub set_merged {
);
}
}
+ };
+ if ($@) {
+ __disallow_relocking($param{locks});
+ __end_control(%info);
+ croak "Failure while trying to adjust bugs, please report this as a bug: $@";
+ }
__disallow_relocking($param{locks});
my ($data,$n_locks) =
__lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
@@ -2176,11 +2172,14 @@ sub set_merged {
}
# finally, we can merge the bugs
- my $action = "Merged ".join(' ',sort keys %merged_bugs);
+ my $action = "Merged ".join(' ',sort { $a <=> $b } keys %merged_bugs);
for my $data (@data) {
my $old_data = dclone($data);
- $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
- keys %merged_bugs);
+ $data->{mergedwith} =
+ join(' ',
+ sort { $a <=> $b }
+ grep {$_ != $data->{bug_num}}
+ keys %merged_bugs);
append_action_to_log(bug => $data->{bug_num},
command => 'merge',
new_data => $data,
@@ -2299,13 +2298,22 @@ sub __calculate_merge_status{
$merged_bugs{$data->{bug_num}} = 1;
$bugs_to_merge = 1;
}
+ }
+ for my $data (@{$data_a}) {
# the master_bug is the bug that every other bug is made to
# look like. However, if merge is set, tags, fixed and found
# are merged.
if ($data->{bug_num} == $master_bug) {
- for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
+ for (qw(package forwarded severity done owner summary outlook affects)) {
$merge_status{$_} = $data->{$_}
}
+ # bugs which are in the newly merged set and are also
+ # blocks/blockedby must be removed before merging
+ for (qw(blocks blockedby)) {
+ $merge_status{$_} =
+ join(' ',grep {not exists $merged_bugs{$_}}
+ split / /,$data->{$_});
+ }
}
if (defined $merge_status) {
next unless $data->{bug_num} == $master_bug;
@@ -2555,7 +2563,6 @@ sub affects {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
$action = '';
@@ -2658,7 +2665,7 @@ Handles all setting of summary fields
If summary is undef, unsets the summary
-If summary is 0, sets the summary to the first paragraph contained in
+If summary is 0 or -1, sets the summary to the first paragraph contained in
the message passed.
If summary is a positive integer, sets the summary to the message specified.
@@ -2733,7 +2740,6 @@ sub _summary {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
# figure out the log that we're going to use
my $summary = '';
my $summary_msg = '';
@@ -2743,10 +2749,10 @@ sub _summary {
print {$debug} "Removing $cmd fields\n";
$action = "Removed $cmd";
}
- elsif ($param{$cmd} =~ /^\d+$/) {
+ elsif ($param{$cmd} =~ /^-?\d+$/) {
my $log = [];
my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
- if ($param{$cmd} == 0) {
+ if ($param{$cmd} == 0 or $param{$cmd} == -1) {
$log = $param{message};
$summary_msg = @records + 1;
}
@@ -2780,12 +2786,13 @@ sub _summary {
}
# skip a paragraph if it looks like it's control or
# pseudo-headers
- if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+ if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
$line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
\#|reopen|close|(?:not|)(?:fixed|found)|clone|
debug|(?:not|)forwarded|priority|
(?:un|)block|limit|(?:un|)archive|
- reassign|retitle|affects|wrongpackage
+ reassign|retitle|affects|package|
+ outlook|
(?:un|force|)merge|user(?:category|tags?|)
)\s+\S}xis) {
if (not length $paragraph) {
@@ -2889,10 +2896,8 @@ sub clone_bug {
__begin_control(%param,
command => 'clone'
);
- my ($debug,$transcript) =
- @info{qw(debug transcript)};
+ my $transcript = $info{transcript};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
@@ -2958,19 +2963,21 @@ sub clone_bug {
# bugs that this bug is blocking are also blocked by the new clone(s)
for my $bug (split ' ', $data->{blocks}) {
for my $new_bug (@new_bugs) {
- set_blocks(bug => $new_bug,
- block => $bug,
+ set_blocks(bug => $bug,
+ block => $new_bug,
+ add => 1,
hash_slice(%param,
keys %common_options,
keys %append_action_options),
);
}
}
- # bugs that this bug is blocked by are also blocking the new clone(s)
+ # bugs that are blocking this bug are also blocking the new clone(s)
for my $bug (split ' ', $data->{blockedby}) {
for my $new_bug (@new_bugs) {
- set_blocks(bug => $bug,
- block => $new_bug,
+ set_blocks(bug => $new_bug,
+ block => $bug,
+ add => 1,
hash_slice(%param,
keys %common_options,
keys %append_action_options),
@@ -3024,7 +3031,6 @@ sub owner {
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @data = @{$info{data}};
- my @bugs = @{$info{bugs}};
my $action = '';
for my $data (@data) {
print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
@@ -3237,10 +3243,18 @@ sub bug_unarchive {
command=>'unarchive');
my ($debug,$transcript) =
@info{qw(debug transcript)};
- my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = "$config{bug} unarchived.";
my @files_to_remove;
+ ## error out if we're unarchiving unarchived bugs
+ for my $data (@{$info{data}}) {
+ if (not defined $data->{archived} or
+ not $data->{archived}
+ ) {
+ __end_control(%info);
+ croak("Bug $data->{bug_num} was not archived; not unarchiving it.");
+ }
+ }
for my $bug (@bugs) {
print {$debug} "$param{bug} removing $bug\n";
my $dir = get_hashname($bug);
@@ -3433,25 +3447,25 @@ sub append_action_to_log{
}
my $msg = join('',
(exists $param{command} ?
- "\n":""
+ "\n":""
),
(length $param{requester} ?
- "\n":""
+ "\n":""
),
(length $param{request_addr} ?
- "\n":""
+ "\n":""
),
"\n",
$data_diff,
- "".html_escape(encode_utf8($param{action}))."\n");
+ "".html_escape(encode_utf8_safely($param{action}))."\n");
if (length $param{requester}) {
- $msg .= "Request was from ".html_escape(encode_utf8($param{requester}))."
\n";
+ $msg .= "Request was from ".html_escape(encode_utf8_safely($param{requester}))."
\n";
}
if (length $param{request_addr}) {
- $msg .= "to ".html_escape(encode_utf8($param{request_addr}))."
";
+ $msg .= "to ".html_escape(encode_utf8_safely($param{request_addr}))."
";
}
if (length $param{desc}) {
- $msg .= ":
\n".encode_utf8($param{desc})."\n";
+ $msg .= ":
\n".encode_utf8_safely($param{desc})."\n";
}
else {
$msg .= ".\n";
@@ -3462,7 +3476,7 @@ sub append_action_to_log{
$msg = '';
if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
push @records, {type => exists $param{recips}?'recips':'incoming-recv',
- exists $param{recips}?(recips => [make_list($param{recips})]):(),
+ exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(),
text => join('',make_list($param{message})),
};
}
@@ -3586,13 +3600,14 @@ sub __return_append_to_log_options{
}
if (not exists $param{message}) {
my $date = rfc822_date();
- $param{message} = fill_in_template(template => 'mail/fake_control_message',
- variables => {request_addr => $param{request_addr},
- requester => $param{requester},
- date => $date,
- action => $action
- },
- );
+ $param{message} =
+ encode_headers(fill_in_template(template => 'mail/fake_control_message',
+ variables => {request_addr => $param{request_addr},
+ requester => $param{requester},
+ date => $date,
+ action => $action
+ },
+ ));
}
if (not defined $action) {
carp "Undefined action!";
@@ -3814,7 +3829,7 @@ LIMIT: for my $limit (make_list($param{limit}{$field})) {
}
if (not $match) {
$going_to_fail = 1;
- print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
+ print {$transcript} qq($field: ').join(', ',map{qq("$_")} make_list($data->{$field})).
"' does not match at least one of ".
join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
}
@@ -3857,7 +3872,7 @@ sub __message_body_template{
$extra_var ||={};
my $hole_var = {'&bugurl' =>
sub{"$_[0]: ".
- 'http://'.$config{cgi_domain}.'/'.
+ $config{cgi_domain}.'/'.
Debbugs::CGI::bug_links(bug => $_[0],
links_only => 1,
);