X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl.pm;h=02bb07e6f5fbb4036dfcc99a216fbac55a4814c4;hb=4b5667efca09883c3c7e96380fe3dfa7e427bce2;hp=5739734b06f24f623ff6ddfc37391451c226fcdf;hpb=a35b0737599506735c5f7f009269e117a58be925;p=debbugs.git diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm index 5739734..02bb07e 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; @@ -378,6 +379,7 @@ 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') { + __end_control(%info); croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers). keys %ok_blockers?'':" and no known blocking bug(s)"; } @@ -386,6 +388,7 @@ sub set_blocks { 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) { + __end_control(%info); croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers); } __end_control(%info); @@ -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; @@ -1742,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; @@ -1969,7 +1955,6 @@ sub set_merged { return; } my @data = @{$info{data}}; - my @bugs = @{$info{bugs}}; my %data; my %merged_bugs; for my $data (@data) { @@ -1980,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"; @@ -1994,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', @@ -2014,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, @@ -2089,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"; } } @@ -2103,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}; @@ -2140,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], @@ -2180,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, @@ -2303,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; @@ -2559,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 = ''; @@ -2662,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. @@ -2737,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 = ''; @@ -2747,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; } @@ -2784,7 +2786,7 @@ 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| @@ -2893,10 +2895,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) { @@ -2962,19 +2962,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), @@ -3028,7 +3030,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"; @@ -3241,7 +3242,6 @@ 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; @@ -3437,25 +3437,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"; @@ -3466,7 +3466,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})), }; } @@ -3590,13 +3590,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!"; @@ -3818,7 +3819,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"; } @@ -3861,7 +3862,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, );