X-Git-Url: https://git.donarmstrong.com/?p=debbugs.git;a=blobdiff_plain;f=Debbugs%2FControl.pm;h=aaa8925a0adfedf8f33ab86be49d9e5a35f28d08;hp=613cb2e7f9cf1a0a4bef8019f8895a2660b8ab40;hb=611a4b401fce2979a485476787afb136acf86af9;hpb=1425b1538c69b15592b851d559eb27697b1f6237 diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm index 613cb2e..aaa8925 100644 --- a/Debbugs/Control.pm +++ b/Debbugs/Control.pm @@ -75,18 +75,19 @@ 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; $DEBUG = 0 unless defined $DEBUG; @EXPORT = (); - %EXPORT_TAGS = (reopen => [qw(reopen)], + %EXPORT_TAGS = (done => [qw(set_done)], submitter => [qw(set_submitter)], severity => [qw(set_severity)], affects => [qw(affects)], summary => [qw(summary)], + outlook => [qw(outlook)], owner => [qw(owner)], title => [qw(set_title)], forward => [qw(set_forwarded)], @@ -94,9 +95,12 @@ BEGIN{ fixed => [qw(set_found set_fixed)], package => [qw(set_package)], block => [qw(set_blocks)], + merge => [qw(set_merged)], tag => [qw(set_tag)], + clone => [qw(clone_bug)], archive => [qw(bug_archive bug_unarchive), ], + limit => [qw(check_limit)], log => [qw(append_action_to_log), ], ); @@ -106,20 +110,23 @@ BEGIN{ } use Debbugs::Config qw(:config); -use Debbugs::Common qw(:lock buglog :misc get_hashname); -use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields); +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); +use Debbugs::Log qw(:misc :write); use Debbugs::Recipients qw(:add); use Debbugs::Packages qw(:versions :mapping); +use Data::Dumper qw(); use Params::Validate qw(validate_with :types); use File::Path qw(mkpath); +use File::Copy qw(copy); 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(); @@ -127,7 +134,8 @@ use Mail::RFC822::Address qw(); use POSIX qw(strftime); use Storable qw(dclone nfreeze); -use List::Util qw(first); +use List::Util qw(first max); +use Encode qw(encode_utf8); use Carp; @@ -166,6 +174,9 @@ my %common_options = (debug => {type => SCALARREF|HANDLE, request_replyto => {type => SCALAR, optional => 1, }, + locks => {type => HASHREF, + optional => 1, + }, ); @@ -191,8 +202,15 @@ my %append_action_options = qw(message), ], }, + # locks is both an append_action option, and a common option; + # it's ok for it to be in both places. + locks => {type => HASHREF, + optional => 1, + }, ); +our $locks = 0; + # this is just a generic stub for Debbugs::Control functions. # @@ -426,22 +444,25 @@ 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 if ($data->{blockedby} eq '') { - print {$transcript} "Was not blocked by any bugs.\n"; + print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n"; } else { - print {$transcript} "Was blocked by: $data->{blockedby}\n"; + print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n"; + } + if ($data->{blocks} eq '') { + print {$transcript} "$data->{bug_num} was not blocking any bugs.\n"; + } else { + print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n"; } my @changed; push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers; push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers; $action = ucfirst(join ('; ',@changed)) if @changed; if (not @changed) { - print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n"; next; } $data->{blockedby} = join(' ',keys %blockers); @@ -463,17 +484,23 @@ sub set_blocks { my %mungable_blocks; $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers; $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 ($new_locks, @blocking_data) = - lock_read_all_merged_bugs($blocker, - ($param{archived}?'archive':())); + my ($temp_locks, @blocking_data) = + lock_read_all_merged_bugs(bug => $blocker, + ($param{archived}?(location => 'archive'):()), + exists $param{locks}?(locks => $param{locks}):(), + ); + $locks+= $temp_locks; + $new_locks+=$temp_locks; if (not @blocking_data) { - unfilelock() for $new_locks; + for (1..$new_locks) { + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; + } die "Unable to get file lock while trying to $add_remove blocker '$blocker'"; } for (map {$_->{bug_num}} @blocking_data) { @@ -519,7 +546,10 @@ sub set_blocks { transcript => $transcript, ); - unfilelock() for $new_locks; + for (1..$new_locks) { + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; + } } } __end_control(%info); @@ -595,10 +625,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}) { @@ -616,11 +644,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; @@ -666,8 +692,7 @@ sub set_tag { push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed; $action = ucfirst(join ('; ',@changed)) if @changed; if (not @changed) { - print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"; next; } $action .= '.'; @@ -710,7 +735,7 @@ sub set_tag { } Sets the severity of a bug. If severity is not passed, is undefined, -or has zero length, sets the severity to the defafult severity. +or has zero length, sets the severity to the default severity. =cut @@ -741,16 +766,14 @@ 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) { if (not defined $data->{severity}) { $data->{severity} = $param{severity}; - $action = "Severity set to '$param{severity}'\n"; + $action = "Severity set to '$param{severity}'"; } else { if ($data->{severity} eq '') { @@ -760,7 +783,7 @@ sub set_severity { print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n"; next; } - $action = "Severity set to '$param{severity}' from '$data->{severity}'\n"; + $action = "Severity set to '$param{severity}' from '$data->{severity}'"; $data->{severity} = $param{severity}; } append_action_to_log(bug => $data->{bug_num}, @@ -778,19 +801,18 @@ sub set_severity { } -=head2 reopen +=head2 set_done eval { - set_foo(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - affected_packages => \%affected_packages, - recipients => \%recipients, - summary => undef, - ); + set_done(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + ); }; if ($@) { $errors++; @@ -801,77 +823,218 @@ Foo frobinates =cut -sub reopen { +sub set_done { my %param = validate_with(params => \@_, spec => {bug => {type => SCALAR, regex => qr/^\d+$/, }, - # specific options here - submitter => {type => SCALAR|UNDEF, - default => undef, + reopen => {type => BOOLEAN, + default => 0, + }, + submitter => {type => SCALAR, + optional => 1, }, + clear_fixed => {type => BOOLEAN, + default => 1, + }, + notify_submitter => {type => BOOLEAN, + default => 1, + }, + original_report => {type => SCALARREF, + optional => 1, + }, + done => {type => SCALAR|UNDEF, + optional => 1, + }, %common_options, %append_action_options, }, ); - $param{submitter} = undef if defined $param{submitter} and - not length $param{submitter}; - - if (defined $param{submitter} and + if (exists $param{submitter} and not Mail::RFC822::Address::valid($param{submitter})) { - die "New submitter address $param{submitter} is not a valid e-mail address"; + die "New submitter address '$param{submitter}' is not a valid e-mail address"; + } + if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address + $param{done} = $param{requester}; + } + if (exists $param{done} and + (not defined $param{done} or + not length $param{done})) { + delete $param{done}; + $param{reopen} = 1; } my %info = __begin_control(%param, - command => 'reopen' + 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 =''; - my $warn_fixed = 1; # avoid warning multiple times if there are - # fixed versions - my @change_submitter = (); - my @bugs_to_reopen = (); - for my $data (@data) { - if (not exists $data->{done} or - not defined $data->{done} or - not length $data->{done}) { - print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n"; - __end_control(%info); - return; + if ($param{reopen}) { + # avoid warning multiple times if there are fixed versions + my $warn_fixed = 1; + for my $data (@data) { + if (not exists $data->{done} or + not defined $data->{done} or + not length $data->{done}) { + print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n"; + __end_control(%info); + return; + } + if (@{$data->{fixed_versions}} and $warn_fixed) { + print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n"; + print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n"; + $warn_fixed = 0; + } + } + $action = "Bug reopened"; + for my $data (@data) { + my $old_data = dclone($data); + $data->{done} = ''; + append_action_to_log(bug => $data->{bug_num}, + command => 'done', + new_data => $data, + old_data => $old_data, + get_lock => 0, + __return_append_to_log_options( + %param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); } - if (@{$data->{fixed_versions}} and $warn_fixed) { - print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n"; - print {$transcript} "you may need to use 'found' to remove fixed versions.\n"; - $warn_fixed = 0; + print {$transcript} "$action\n"; + __end_control(%info); + if (exists $param{submitter}) { + set_submitter(bug => $param{bug}, + submitter => $param{submitter}, + hash_slice(%param, + keys %common_options, + keys %append_action_options) + ); } - if (defined $param{submitter} and length $param{submitter} - and $data->{originator} ne $param{submitter}) { - push @change_submitter,$data->{bug_num}; + # clear the fixed revisions + if ($param{clear_fixed}) { + set_fixed(fixed => [], + bug => $param{bug}, + reopen => 0, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); } } - __end_control(%info); - my @params_for_subcalls = - map {exists $param{$_}?($_,$param{$_}):()} - (keys %common_options, - keys %append_action_options, - ); + else { + my %submitter_notified; + my $orig_report_set = 0; + for my $data (@data) { + if (exists $data->{done} and + defined $data->{done} and + length $data->{done}) { + print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n"; + __end_control(%info); + return; + } + } + for my $data (@data) { + my $old_data = dclone($data); + my $hash = get_hashname($data->{bug_num}); + my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or + die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!"; + my $orig_report; + { + local $/; + $orig_report= <$report_fh>; + } + close $report_fh; + if (not $orig_report_set and defined $orig_report and + length $orig_report and + exists $param{original_report}){ + ${$param{original_report}} = $orig_report; + $orig_report_set = 1; + } - for my $bug (@change_submitter) { - set_submitter(bug=>$bug, - submitter => $param{submitter}, - @params_for_subcalls, + $action = "Marked $config{bug} as done"; + + # set done to the requester + $data->{done} = exists $param{done}?$param{done}:$param{requester}; + append_action_to_log(bug => $data->{bug_num}, + command => 'done', + new_data => $data, + old_data => $old_data, + get_lock => 0, + __return_append_to_log_options( + %param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); + print {$transcript} "$action\n"; + # get the original report + if ($param{notify_submitter}) { + my $submitter_message; + if(not exists $submitter_notified{$data->{originator}}) { + $submitter_message = + create_mime_message([default_headers(queue_file => $param{request_nn}, + data => $data, + msgid => $param{request_msgid}, + msgtype => 'notifdone', + pr_msg => 'they-closed', + headers => + [To => $data->{submitter}, + Subject => "$config{ubug}#$data->{bug_num} ". + "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""), + ], + ) + ], + __message_body_template('mail/process_your_bug_done', + {data => $data, + replyto => (exists $param{request_replyto} ? + $param{request_replyto} : + $param{requester} || 'Unknown'), + markedby => $param{requester}, + subject => $param{request_subject}, + messageid => $param{request_msgid}, + config => \%config, + }), + [join('',make_list($param{message})),$orig_report] + ); + send_mail_message(message => $submitter_message, + recipients => $old_data->{submitter}, + ); + $submitter_notified{$data->{originator}} = $submitter_message; + } + else { + $submitter_message = $submitter_notified{$data->{originator}}; + } + append_action_to_log(bug => $data->{bug_num}, + action => "Notification sent", + requester => '', + request_addr => $data->{originator}, + desc => "$config{bug} acknowledged by developer.", + recips => [$data->{originator}], + message => $submitter_message, + get_lock => 0, + ); + } + } + __end_control(%info); + if (exists $param{fixed}) { + set_fixed(fixed => $param{fixed}, + bug => $param{bug}, + reopen => 0, + hash_slice(%param, + keys %common_options, + keys %append_action_options + ), ); + } } - set_fixed(fixed => [], - bug => $param{bug}, - reopen => 1, - ); } @@ -925,7 +1088,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]) { @@ -936,13 +1098,12 @@ sub set_submitter { (not defined $data->{originator} or not length $data->{originator})) or (defined $param{submitter} and defined $data->{originator} and $param{submitter} eq $data->{originator})) { - print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n" - unless __internal_request(); + print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n"; next; } 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 { @@ -1033,6 +1194,7 @@ sub set_forwarded { if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) { die "Non-printable characters are not allowed in the forwarded field"; } + $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded}; my %info = __begin_control(%param, command => 'forwarded' @@ -1040,16 +1202,14 @@ 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); print {$debug} "Going to change bug forwarded\n"; - if (((not defined $param{forwarded} or not length $param{forwarded}) and - (not defined $data->{forwarded} or not length $data->{forwarded})) or - $param{forwarded} eq $data->{forwarded}) { - print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n" - unless __internal_request(); + if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or + (not defined $param{forwarded} and + defined $data->{forwarded} and not length $data->{forwarded})) { + print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n"; next; } else { @@ -1057,7 +1217,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}'."; @@ -1130,20 +1290,18 @@ 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); print {$debug} "Going to change bug title\n"; if (defined $data->{subject} and length($data->{subject}) and $data->{subject} eq $param{title}) { - print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n" - unless __internal_request(); + print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n"; next; } 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}'."; } @@ -1226,7 +1384,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(',', @@ -1242,8 +1399,7 @@ sub set_package { print {$debug} "Going to change assigned package\n"; if (defined $data->{package} and length($data->{package}) and $data->{package} eq $new_package) { - print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n" - unless __internal_request(); + print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n"; next; } else { @@ -1351,7 +1507,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; @@ -1407,6 +1562,16 @@ sub set_found { if (not @svers) { @svers = $version; } + 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; + } + } for my $sver (@svers) { if (not exists $found_versions{$sver}) { $found_versions{$sver} = 1; @@ -1414,7 +1579,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; } @@ -1422,11 +1587,11 @@ sub set_found { # We only care about reopening the bug if the bug is # not done if (defined $data->{done} and length $data->{done}) { - my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);} - map {m{([^/]+)$}; $1;} @svers; + my @svers_order = sort_versions(map {m{([^/]+)$}; $1;} + @svers); # determine if we need to reopen - my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);} - map {m{([^/]+)$}; $1;} keys %fixed_versions; + my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;} + keys %fixed_versions); if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) { $reopened = 1; @@ -1438,7 +1603,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; } @@ -1470,13 +1635,12 @@ sub set_found { push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed; # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added; push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed; - $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed; + $action = ucfirst(join ('; ',@changed)) if @changed; if ($reopened) { $action .= " and reopened" } if (not $reopened and not @changed) { - print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n"; next; } $action .= '.'; @@ -1562,7 +1726,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; @@ -1619,6 +1782,12 @@ sub set_fixed { if (not @svers) { @svers = $version; } + else { + if (exists $fixed_versions{$version}) { + $fixed_removed{$version} = 1; + delete $fixed_versions{$version}; + } + } for my $sver (@svers) { if (not exists $fixed_versions{$sver}) { $fixed_versions{$sver} = 1; @@ -1679,13 +1848,12 @@ sub set_fixed { push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed; push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added; push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed; - $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed; + $action = ucfirst(join ('; ',@changed)) if @changed; if ($reopened) { $action .= " and reopened" } if (not $reopened and not @changed) { - print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n"; next; } $action .= '.'; @@ -1707,6 +1875,603 @@ sub set_fixed { } +=head2 set_merged + + eval { + set_merged(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + merge_with => 12345, + add => 1, + force => 1, + allow_reassign => 1, + reassign_same_source_only => 1, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set merged on $ref: $@"; + } + + +Sets, adds, or removes the specified merged bugs of a bug + +By default, requires + +=cut + +sub set_merged { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + merge_with => {type => ARRAYREF|SCALAR, + optional => 1, + }, + remove => {type => BOOLEAN, + default => 0, + }, + force => {type => BOOLEAN, + default => 0, + }, + masterbug => {type => BOOLEAN, + default => 0, + }, + allow_reassign => {type => BOOLEAN, + default => 0, + }, + reassign_different_sources => {type => BOOLEAN, + default => 1, + }, + %common_options, + %append_action_options, + }, + ); + my @merging = exists $param{merge_with} ? make_list($param{merge_with}):(); + my %merging; + @merging{@merging} = (1) x @merging; + if (grep {$_ !~ /^\d+$/} @merging) { + croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging); + } + $param{locks} = {} if not exists $param{locks}; + my %info = + __begin_control(%param, + command => 'merge' + ); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + if (not @merging and exists $param{merge_with}) { + print {$transcript} "Requested to merge with no additional bugs; not doing anything\n"; + __end_control(%info); + return; + } + my @data = @{$info{data}}; + my %data; + my %merged_bugs; + for my $data (@data) { + $data{$data->{bug_num}} = $data; + my @merged_bugs = split / /, $data->{mergedwith}; + @merged_bugs{@merged_bugs} = (1) x @merged_bugs; + } + # handle unmerging + my $new_locks = 0; + if (not exists $param{merge_with}) { + 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"; + __end_control(%info); + return; + } + my $action = "Disconnected #$param{bug} from all other report(s)."; + for my $data (@data) { + my $old_data = dclone($data); + if ($data->{bug_num} == $param{bug}) { + $data->{mergedwith} = ''; + } + else { + $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}} + keys %merged_bugs); + } + append_action_to_log(bug => $data->{bug_num}, + command => 'merge', + new_data => $data, + old_data => $old_data, + get_lock => 0, + __return_append_to_log_options(%param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); + } + print {$transcript} "$action\n"; + __end_control(%info); + return; + } + # lock and load all of the bugs we need + my ($data,$n_locks) = + __lock_and_load_merged_bugs(bugs_to_load => [keys %merging], + data => \@data, + locks => $param{locks}, + debug => $debug, + ); + $new_locks += $n_locks; + %data = %{$data}; + @data = values %data; + if (not check_limit(data => [@data], + exists $param{limit}?(limit => $param{limit}):(), + transcript => $transcript, + )) { + die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data); + } + for my $data (@data) { + $data{$data->{bug_num}} = $data; + $merged_bugs{$data->{bug_num}} = 1; + my @merged_bugs = split / /, $data->{mergedwith}; + @merged_bugs{@merged_bugs} = (1) x @merged_bugs; + if (exists $param{affected_bugs}) { + $param{affected_bugs}{$data->{bug_num}} = 1; + } + } + __handle_affected_packages(%param,data => [@data]); + my %bug_info_shown; # which bugs have had information shown + $bug_info_shown{$param{bug}} = 1; + add_recipients(data => [@data], + recipients => $param{recipients}, + (exists $param{command}?(actions_taken => {$param{command} => 1}):()), + debug => $debug, + (__internal_request()?(transcript => $transcript):()), + ); + + # Figure out what the ideal state is for the bug, + my ($merge_status,$bugs_to_merge) = + __calculate_merge_status(\@data,\%data,$param{bug}); + # find out if we actually have any bugs to merge + if (not $bugs_to_merge) { + print {$transcript} "Requested to merge with no additional bugs; not doing anything\n"; + for (1..$new_locks) { + unfilelock($param{locks}); + $locks--; + } + __end_control(%info); + return; + } + # see what changes need to be made to merge the bugs + # check to make sure that the set of changes we need to make is allowed + my ($disallowed_changes,$changes) = + __calculate_merge_changes(\@data,$merge_status,\%param); + # at this point, stop if there are disallowed changes, otherwise + # make the allowed changes, and then reread the bugs in question + # to get the new data, then recaculate the merges; repeat + # reloading and recalculating until we try too many times or there + # are no changes to make. + + my $attempts = 0; + # we will allow at most 4 times through this; more than 1 + # shouldn't really happen. + my %bug_changed; + while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) { + if ($attempts > 1) { + print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n"; + } + if (@{$disallowed_changes}) { + # figure out the problems + print {$transcript} "Unable to merge bugs because:\n"; + for my $change (@{$disallowed_changes}) { + print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n"; + } + if ($attempts > 0) { + croak "Some bugs were altered while attempting to merge"; + } + else { + croak "Did not alter merged bugs"; + } + } + my @bugs_to_change = keys %{$changes}; + for my $change_bug (@bugs_to_change) { + next unless exists $changes->{$change_bug}; + $bug_changed{$change_bug}++; + print {$transcript} __bug_info($data{$change_bug}) if + $param{show_bug_info} and not __internal_request(1); + $bug_info_shown{$change_bug} = 1; + __allow_relocking($param{locks},[keys %data]); + 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; + for my $key (split / /,$change->{orig_value}) { + delete $unhandled_targets{$key}; + next if exists $target_blockedby{$key}; + set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug}, + block => $change->{field} eq 'blocks' ? $change->{bug} : $key, + remove => 1, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + for my $key (keys %unhandled_targets) { + set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug}, + block => $change->{field} eq 'blocks' ? $change->{bug} : $key, + add => 1, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } + else { + $change->{function}->(bug => $change->{bug}, + $change->{key}, $change->{func_value}, + exists $change->{options}?@{$change->{options}}:(), + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } + __disallow_relocking($param{locks}); + my ($data,$n_locks) = + __lock_and_load_merged_bugs(bugs_to_load => [keys %merging], + data => \@data, + locks => $param{locks}, + debug => $debug, + reload_all => 1, + ); + $new_locks += $n_locks; + $locks += $n_locks; + %data = %{$data}; + @data = values %data; + ($merge_status,$bugs_to_merge) = + __calculate_merge_status(\@data,\%data,$param{bug},$merge_status); + ($disallowed_changes,$changes) = + __calculate_merge_changes(\@data,$merge_status,\%param); + $attempts = max(values %bug_changed); + } + } + if ($param{show_bug_info} and not __internal_request(1)) { + for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) { + next if $bug_info_shown{$data->{bug_num}}; + print {$transcript} __bug_info($data); + } + } + if (keys %{$changes} or @{$disallowed_changes}) { + print {$transcript} "After four attempts, the following changes were unable to be made:\n"; + for (1..$new_locks) { + unfilelock($param{locks}); + $locks--; + } + __end_control(%info); + for my $change ((map {@{$_}} values %{$changes}), @{$disallowed_changes}) { + print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n"; + } + die "Unable to modify bugs so they could be merged"; + return; + } + + # finally, we can merge the bugs + my $action = "Merged ".join(' ',sort keys %merged_bugs); + for my $data (@data) { + my $old_data = dclone($data); + $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}} + keys %merged_bugs); + append_action_to_log(bug => $data->{bug_num}, + command => 'merge', + new_data => $data, + old_data => $old_data, + get_lock => 0, + __return_append_to_log_options(%param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); + } + print {$transcript} "$action\n"; + # unlock the extra locks that we got earlier + for (1..$new_locks) { + unfilelock($param{locks}); + $locks--; + } + __end_control(%info); +} + +sub __allow_relocking{ + my ($locks,$bugs) = @_; + + my @locks = (@{$bugs},'merge'); + for my $lock (@locks) { + my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}}; + next unless @lockfiles; + $locks->{relockable}{$lockfiles[0]} = 0; + } +} + +sub __disallow_relocking{ + my ($locks) = @_; + delete $locks->{relockable}; +} + +sub __lock_and_load_merged_bugs{ + my %param = + validate_with(params => \@_, + spec => + {bugs_to_load => {type => ARRAYREF, + default => sub {[]}, + }, + data => {type => HASHREF|ARRAYREF, + }, + locks => {type => HASHREF, + default => sub {{};}, + }, + reload_all => {type => BOOLEAN, + default => 0, + }, + debug => {type => HANDLE, + }, + }, + ); + my %data; + my $new_locks = 0; + if (ref($param{data}) eq 'ARRAY') { + for my $data (@{$param{data}}) { + $data{$data->{bug_num}} = dclone($data); + } + } + else { + %data = %{dclone($param{data})}; + } + my @bugs_to_load = @{$param{bugs_to_load}}; + if ($param{reload_all}) { + push @bugs_to_load, keys %data; + } + my %temp; + @temp{@bugs_to_load} = (1) x @bugs_to_load; + @bugs_to_load = keys %temp; + my %loaded_this_time; + my $bug_to_load; + while ($bug_to_load = shift @bugs_to_load) { + if (not $param{reload_all}) { + next if exists $data{$bug_to_load}; + } + else { + next if $loaded_this_time{$bug_to_load}; + } + my $lock_bug = 1; + if ($param{reload_all}) { + if (exists $data{$bug_to_load}) { + $lock_bug = 0; + } + } + my $data = + read_bug(bug => $bug_to_load, + lock => $lock_bug, + locks => $param{locks}, + ) or + die "Unable to load bug $bug_to_load"; + print {$param{debug}} "read bug $bug_to_load\n"; + $data{$data->{bug_num}} = $data; + $new_locks += $lock_bug; + $loaded_this_time{$data->{bug_num}} = 1; + push @bugs_to_load, + grep {not exists $data{$_}} + split / /,$data->{mergedwith}; + } + return (\%data,$new_locks); +} + + +sub __calculate_merge_status{ + my ($data_a,$data_h,$master_bug,$merge_status) = @_; + my %merge_status = %{$merge_status // {}}; + my %merged_bugs; + my $bugs_to_merge = 0; + for my $data (@{$data_a}) { + # check to see if this bug is unmerged in the set + if (not length $data->{mergedwith} or + grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) { + $merged_bugs{$data->{bug_num}} = 1; + $bugs_to_merge = 1; + } + # 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)) { + $merge_status{$_} = $data->{$_} + } + } + if (defined $merge_status) { + next unless $data->{bug_num} == $master_bug; + } + $merge_status{tag} = {} if not exists $merge_status{tag}; + for my $tag (split /\s+/, $data->{keywords}) { + $merge_status{tag}{$tag} = 1; + } + $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}}); + for (qw(fixed found)) { + @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}}; + } + } + # if there is a non-source qualified version with a corresponding + # source qualified version, we only want to merge the source + # qualified version(s) + for (qw(fixed found)) { + my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}}; + for my $unqualified_version (@unqualified_versions) { + if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) { + delete $merge_status{"${_}_versions"}{$unqualified_version}; + } + } + } + return (\%merge_status,$bugs_to_merge); +} + + + +sub __calculate_merge_changes{ + my ($datas,$merge_status,$param) = @_; + my %changes; + my @disallowed_changes; + for my $data (@{$datas}) { + # things that can be forced + # + # * func is the function to set the new value + # + # * key is the key of the function to set the value, + + # * modify_value is a function which is called to modify the new + # value so that the function will accept it + + # * options is an ARRAYREF of options to pass to the function + + # * allowed is a BOOLEAN which controls whether this setting + # is allowed to be different by default. + my %force_functions = + (forwarded => {func => \&set_forwarded, + key => 'forwarded', + options => [], + }, + severity => {func => \&set_severity, + key => 'severity', + options => [], + }, + blocks => {func => \&set_blocks, + modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]}, + key => 'block', + options => [], + }, + blockedby => {func => \&set_blocks, + modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]}, + key => 'block', + options => [], + }, + done => {func => \&set_done, + key => 'done', + options => [], + }, + owner => {func => \&owner, + key => 'owner', + options => [], + }, + summary => {func => \&summary, + key => 'summary', + options => [], + }, + outlook => {func => \&outlook, + key => 'outlook', + options => [], + }, + affects => {func => \&affects, + key => 'package', + options => [], + }, + package => {func => \&set_package, + key => 'package', + options => [], + }, + keywords => {func => \&set_tag, + key => 'tag', + modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]}, + allowed => 1, + }, + fixed_versions => {func => \&set_fixed, + key => 'fixed', + modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]}, + allowed => 1, + }, + found_versions => {func => \&set_found, + key => 'found', + modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]}, + allowed => 1, + }, + ); + for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) { + # if the ideal bug already has the field set properly, we + # continue on. + if ($field eq 'keywords'){ + next if join(' ',sort split /\s+/,$data->{keywords}) eq + join(' ',sort keys %{$merge_status->{tag}}); + } + elsif ($field =~ /^(?:fixed|found)_versions$/) { + next if join(' ', sort @{$data->{$field}}) eq + join(' ',sort keys %{$merge_status->{$field}}); + } + elsif ($field eq 'done') { + # for done, we only care if the bug is done or not + # done, not the value it's set to. + if (defined $merge_status->{$field} and length $merge_status->{$field} and + defined $data->{$field} and length $data->{$field}) { + next; + } + elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and + (not defined $data->{$field} or not length $data->{$field}) + ) { + next; + } + } + elsif ($merge_status->{$field} eq $data->{$field}) { + next; + } + my $change = + {field => $field, + bug => $data->{bug_num}, + orig_value => $data->{$field}, + func_value => + (exists $force_functions{$field}{modify_value} ? + $force_functions{$field}{modify_value}->($merge_status->{$field}): + $merge_status->{$field}), + value => $merge_status->{$field}, + function => $force_functions{$field}{func}, + key => $force_functions{$field}{key}, + options => $force_functions{$field}{options}, + allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0, + }; + $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value}; + $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value}; + if ($param->{force} or $change->{allowed}) { + if ($field ne 'package' or $change->{allowed}) { + push @{$changes{$data->{bug_num}}},$change; + next; + } + if ($param->{allow_reassign}) { + if ($param->{reassign_different_sources}) { + push @{$changes{$data->{bug_num}}},$change; + next; + } + # allow reassigning if binary_to_source returns at + # least one of the same source packages + my @merge_status_source = + binary_to_source(package => $merge_status->{package}, + source_only => 1, + ); + my @other_bug_source = + binary_to_source(package => $data->{package}, + source_only => 1, + ); + my %merge_status_sources; + @merge_status_sources{@merge_status_source} = + (1) x @merge_status_source; + if (grep {$merge_status_sources{$_}} @other_bug_source) { + push @{$changes{$data->{bug_num}}},$change; + next; + } + } + } + push @disallowed_changes,$change; + } + # blocks and blocked by are weird; we have to go through and + # set blocks to the other half of the merged bugs + } + return (\@disallowed_changes,\%changes); +} =head2 affects @@ -1745,9 +2510,9 @@ sub affects { regex => qr/^\d+$/, }, # specific options here - packages => {type => SCALAR|ARRAYREF, - default => [], - }, + package => {type => SCALAR|ARRAYREF|UNDEF, + default => [], + }, add => {type => BOOLEAN, default => 0, }, @@ -1761,6 +2526,9 @@ sub affects { if ($param{add} and $param{remove}) { croak "Asking to both add and remove affects is nonsensical"; } + if (not defined $param{package}) { + $param{package} = []; + } my %info = __begin_control(%param, command => 'affects' @@ -1768,7 +2536,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 = ''; @@ -1778,7 +2545,7 @@ sub affects { @packages{@packages} = (1) x @packages; if ($param{add}) { my @added = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { next unless defined $package and length $package; if (not $packages{$package}) { $packages{$package} = 1; @@ -1792,7 +2559,7 @@ sub affects { } elsif ($param{remove}) { my @removed = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { if ($packages{$package}) { next unless defined $package and length $package; delete $packages{$package}; @@ -1806,7 +2573,7 @@ sub affects { my %added_packages = (); my %removed_packages = %packages; %packages = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { next unless defined $package and length $package; $packages{$package} = 1; delete $removed_packages{$package}; @@ -1823,8 +2590,8 @@ sub affects { } } if (not length $action) { - print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n"; + next; } my $old_data = dclone($data); $data->{affects} = join(',',keys %packages); @@ -1871,63 +2638,106 @@ 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 numeric, sets the summary to the message specified. +If summary is a positive integer, sets the summary to the message specified. +Otherwise, sets summary to the value passed. =cut sub summary { - my %param = validate_with(params => \@_, + # outlook and summary are exactly the same, basically + return _summary('summary',@_); +} + +=head1 OUTLOOK FUNCTIONS + +=head2 outlook + + eval { + outlook(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + outlook => undef, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to mark $ref with outlook foo: $@"; + } + +Handles all setting of outlook fields + +If outlook is undef, unsets the outlook + +If outlook is 0, sets the outlook to the first paragraph contained in +the message passed. + +If outlook is a positive integer, sets the outlook to the message specified. + +Otherwise, sets outlook to the value passed. + +=cut + + +sub outlook { + return _summary('outlook',@_); +} + +sub _summary { + my ($cmd,@params) = @_; + my %param = validate_with(params => \@params, spec => {bug => {type => SCALAR, regex => qr/^\d+$/, }, # specific options here - summary => {type => SCALAR|UNDEF, - default => 0, - }, + $cmd , {type => SCALAR|UNDEF, + default => 0, + }, %common_options, %append_action_options, }, ); - croak "summary must be numeric or undef" if - defined $param{summary} and not $param{summary} =~ /^\d+$/; my %info = __begin_control(%param, - command => 'summary' + command => $cmd, ); 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 = ''; my $action = ''; - if (not defined $param{summary}) { + if (not defined $param{$cmd}) { # do nothing - print {$debug} "Removing summary fields\n"; - $action = 'Removed summary'; + print {$debug} "Removing $cmd fields\n"; + $action = "Removed $cmd"; } - else { + elsif ($param{$cmd} =~ /^-?\d+$/) { my $log = []; my @records = Debbugs::Log::read_log_records(bug_num => $param{bug}); - if ($param{summary} == 0) { + if ($param{$cmd} == 0 or $param{$cmd} == -1) { $log = $param{message}; $summary_msg = @records + 1; } else { - if (($param{summary} - 1 ) > $#records) { - die "Message number '$param{summary}' exceeds the maximum message '$#records'"; + if (($param{$cmd} - 1 ) > $#records) { + die "Message number '$param{$cmd}' exceeds the maximum message '$#records'"; } - my $record = $records[($param{summary} - 1 )]; + my $record = $records[($param{$cmd} - 1 )]; if ($record->{type} !~ /incoming-recv|recips/) { - die "Message number '$param{summary}' is a invalid message type '$record->{type}'"; + die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'"; } - $summary_msg = $param{summary}; + $summary_msg = $param{$cmd}; $log = [$record->{text}]; } my $p_o = Debbugs::MIME::parse(join('',@{$log})); @@ -1949,7 +2759,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| @@ -1966,36 +2776,38 @@ sub summary { next if $in_pseudoheaders; $paragraph .= $line ." \n"; } - print {$debug} "Summary is going to be '$paragraph'\n"; + print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n"; $summary = $paragraph; $summary =~ s/[\n\r]/ /g; if (not length $summary) { - die "Unable to find summary message to use"; + die "Unable to find $cmd message to use"; } # trim off a trailing spaces $summary =~ s/\ *$//; } + else { + $summary = $param{$cmd}; + } for my $data (@data) { - print {$debug} "Going to change summary\n"; + print {$debug} "Going to change $cmd\n"; if (((not defined $summary or not length $summary) and - (not defined $data->{summary} or not length $data->{summary})) or - $summary eq $data->{summary}) { - print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n" - unless __internal_request(); + (not defined $data->{$cmd} or not length $data->{$cmd})) or + $summary eq $data->{$cmd}) { + print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n"; next; } if (length $summary) { - if (length $data->{summary}) { - $action = "Summary replaced with message bug $param{bug} message $summary_msg"; + if (length $data->{$cmd}) { + $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg"; } else { - $action = "Summary recorded from message bug $param{bug} message $summary_msg"; + $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg"; } } my $old_data = dclone($data); - $data->{summary} = $summary; + $data->{$cmd} = $summary; append_action_to_log(bug => $data->{bug_num}, - command => 'summary', + command => $cmd, old_data => $old_data, new_data => $data, get_lock => 0, @@ -2013,6 +2825,140 @@ sub summary { +=head2 clone_bug + + eval { + clone_bug(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to clone bug $ref bar: $@"; + } + +Clones the given bug. + +We currently don't support cloning merged bugs, but this could be +handled by internally unmerging, cloning, then remerging the bugs. + +=cut + +sub clone_bug { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + new_bugs => {type => ARRAYREF, + }, + new_clones => {type => HASHREF, + default => {}, + }, + %common_options, + %append_action_options, + }, + ); + my %info = + __begin_control(%param, + command => 'clone' + ); + my $transcript = $info{transcript}; + my @data = @{$info{data}}; + + my $action = ''; + for my $data (@data) { + if (length($data->{mergedwith})) { + die "Bug is marked as being merged with others. Use an existing clone.\n"; + } + } + if (@data != 1) { + die "Not exactly one bug‽ This shouldn't happen."; + } + my $data = $data[0]; + my %clones; + for my $newclone_id (@{$param{new_bugs}}) { + my $new_bug_num = new_bug(copy => $data->{bug_num}); + $param{new_clones}{$newclone_id} = $new_bug_num; + $clones{$newclone_id} = $new_bug_num; + } + my @new_bugs = sort values %clones; + my @collapsed_ids; + for my $new_bug (@new_bugs) { + # no collapsed ids or the higher collapsed id is not one less + # than the next highest new bug + if (not @collapsed_ids or + $collapsed_ids[-1][1]+1 != $new_bug) { + push @collapsed_ids,[$new_bug,$new_bug]; + } + else { + $collapsed_ids[-1][1] = $new_bug; + } + } + my @collapsed; + for my $ci (@collapsed_ids) { + if ($ci->[0] == $ci->[1]) { + push @collapsed,$ci->[0]; + } + else { + push @collapsed,$ci->[0].'-'.$ci->[1] + } + } + my $collapsed_str = english_join(\@collapsed); + $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str; + for my $new_bug (@new_bugs) { + append_action_to_log(bug => $new_bug, + get_lock => 1, + __return_append_to_log_options( + %param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + } + append_action_to_log(bug => $data->{bug_num}, + get_lock => 0, + __return_append_to_log_options( + %param, + action => $action, + ), + ) + if not exists $param{append_log} or $param{append_log}; + writebug($data->{bug_num},$data); + print {$transcript} "$action\n"; + __end_control(%info); + # 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 => $bug, + block => $new_bug, + add => 1, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } + # 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 => $new_bug, + block => $bug, + add => 1, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } +} + + =head1 OWNER FUNCTIONS @@ -2057,15 +3003,13 @@ 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"; print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n"; if (not defined $param{owner} or not length $param{owner}) { if (not defined $data->{owner} or not length $data->{owner}) { - print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n" - unless __internal_request(); + print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n"; next; } $param{owner} = ''; @@ -2176,7 +3120,6 @@ sub bug_archive { print {$transcript} "Bug $param{bug} cannot be archived\n"; die "Bug $param{bug} cannot be archived"; } - print {$debug} "$param{bug} considering\n"; if (not $param{archive_unarchived} and not exists $data[0]{unarchived} ) { @@ -2232,7 +3175,7 @@ sub bug_archive { print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n"; } unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove); - print {$transcript} "deleted $bug (from $param{bug})\n"; + print {$debug} "deleted $bug (from $param{bug})\n"; } bughook_archive(@bugs); __end_control(%info); @@ -2272,7 +3215,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; @@ -2353,12 +3295,18 @@ sub append_action_to_log{ message => {type => SCALAR|ARRAYREF, default => '', }, + recips => {type => SCALAR|ARRAYREF, + optional => 1 + }, desc => {type => SCALAR, default => '', }, get_lock => {type => BOOLEAN, default => 1, }, + locks => {type => HASHREF, + optional => 1, + }, # we don't use # append_action_options here # because some of these @@ -2373,10 +3321,12 @@ sub append_action_to_log{ die "Unable to find .log for $param{bug}" if not defined $log_location; if ($param{get_lock}) { - filelock("lock/$param{bug}"); + filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:()); + $locks++; } - my $log = IO::File->new(">>$log_location") or - die "Unable to open $log_location for appending: $!"; + my @records; + my $logfh = IO::File->new(">>$log_location") or + die "Unable to open $log_location for appending: $!"; # determine difference between old and new my $data_diff = ''; if (exists $param{old_data} and exists $param{new_data}) { @@ -2397,7 +3347,6 @@ sub append_action_to_log{ ref($old_data->{$key}) and ref($new_data->{$key}) eq ref($old_data->{$key})) { local $Storable::canonical = 1; - # print STDERR Dumper($new_data,$old_data,$key); if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) { delete $new_data->{$key}; delete $old_data->{$key}; @@ -2444,7 +3393,7 @@ sub append_action_to_log{ $nd{$key} = $new_data->{$key}; # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n"; } - $data_diff .= html_escape(Data::Dumper->Dump([\%nd],[qw(new_data)])); + $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)])); $data_diff .= "-->\n"; $data_diff .= "\n"; } - my $msg = join('',"\6\n", + my $msg = join('', (exists $param{command} ? - "\n":"" + "\n":"" ), (length $param{requester} ? - "\n":"" + "\n":"" ), (length $param{request_addr} ? - "\n":"" + "\n":"" ), "\n", $data_diff, - "".html_escape($param{action})."\n"); + "".html_escape(encode_utf8_safely($param{action}))."\n"); if (length $param{requester}) { - $msg .= "Request was from ".html_escape($param{requester})."\n"; + $msg .= "Request was from ".html_escape(encode_utf8_safely($param{requester}))."\n"; } if (length $param{request_addr}) { - $msg .= "to ".html_escape($param{request_addr}).""; + $msg .= "to ".html_escape(encode_utf8_safely($param{request_addr})).""; } if (length $param{desc}) { - $msg .= ":
\n$param{desc}\n"; + $msg .= ":
\n".encode_utf8_safely($param{desc})."\n"; } else { $msg .= ".\n"; } - $msg .= "\3\n"; + push @records, {type => 'html', + text => $msg, + }; + $msg = ''; if ((ref($param{message}) and @{$param{message}}) or length($param{message})) { - $msg .= "\7\n".join('',escape_log(make_list($param{message})))."\n\3\n" - or die "Unable to append to $log_location: $!"; + push @records, {type => exists $param{recips}?'recips':'incoming-recv', + exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(), + text => join('',make_list($param{message})), + }; } - print {$log} $msg or die "Unable to append to $log_location: $!"; - close $log or die "Unable to close $log_location: $!"; + write_log_records(logfh=>$logfh, + records => \@records, + ); + close $logfh or die "Unable to close $log_location: $!"; if ($param{get_lock}) { - unfilelock(); + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; } @@ -2606,21 +3563,21 @@ 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!"; $action = "unknown action"; } return (action => $action, - (map {exists $append_action_options{$_}?($_,$param{$_}):()} - keys %param), + hash_slice(%param,keys %append_action_options), ); } @@ -2657,7 +3614,7 @@ corresponding to this request =cut -our $locks = 0; +our $lockhash; sub __begin_control { my %param = validate_with(params => \@_, @@ -2676,14 +3633,18 @@ sub __begin_control { ); my $new_locks; my ($debug,$transcript) = __handle_debug_transcript(@_); - print {$debug} "$param{bug} considering\n"; + print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n"; +# print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n"; + $lockhash = $param{locks} if exists $param{locks}; my @data = (); my $old_die = $SIG{__DIE__}; $SIG{__DIE__} = *sig_die{CODE}; ($new_locks, @data) = - lock_read_all_merged_bugs($param{bug}, - ($param{archived}?'archive':())); + lock_read_all_merged_bugs(bug => $param{bug}, + $param{archived}?(location => 'archive'):(), + exists $param{locks} ? (locks => $param{locks}):(), + ); $locks += $new_locks; if (not @data) { die "Unable to read any bugs successfully."; @@ -2695,7 +3656,7 @@ sub __begin_control { } } } - if (not __check_limit(data => \@data, + if (not check_limit(data => \@data, exists $param{limit}?(limit => $param{limit}):(), transcript => $transcript, )) { @@ -2727,6 +3688,7 @@ sub __begin_control { debug => $debug, transcript => $transcript, param => \%param, + exists $param{locks}?(locks => $param{locks}):(), ); } @@ -2743,12 +3705,13 @@ sub __end_control { if (exists $info{new_locks} and $info{new_locks} > 0) { print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n"; for (1..$info{new_locks}) { - unfilelock(); + unfilelock(exists $info{locks}?$info{locks}:()); + $locks--; } } $SIG{__DIE__} = $info{old_die}; - if (exists $info{param}{bugs_affected}) { - @{$info{param}{bugs_affected}}{@{$info{bugs}}} = (1) x @{$info{bugs}}; + if (exists $info{param}{affected_bugs}) { + @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}}; } add_recipients(recipients => $info{param}{recipients}, (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()), @@ -2760,9 +3723,9 @@ sub __end_control { } -=head2 __check_limit +=head2 check_limit - __check_limit(data => \@data, limit => $param{limit}); + check_limit(data => \@data, limit => $param{limit}); Checks to make sure that bugs match any limits; each entry of @data @@ -2779,9 +3742,9 @@ limit to succeed. =cut -sub __check_limit{ +sub check_limit{ my %param = validate_with(params => \@_, - spec => {data => {type => ARRAYREF|SCALAR, + spec => {data => {type => ARRAYREF|HASHREF, }, limit => {type => HASHREF|UNDEF, }, @@ -2799,20 +3762,28 @@ sub __check_limit{ my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef); my $going_to_fail = 0; for my $data (@data) { + $data = split_status_fields(get_bug_status(bug => $data->{bug_num}, + status => dclone($data), + )); for my $field (keys %{$param{limit}}) { next unless exists $param{limit}{$field}; my $match = 0; - for my $limit (make_list($param{limit}{$field})) { + my @data_fields = make_list($data->{$field}); +LIMIT: for my $limit (make_list($param{limit}{$field})) { if (not ref $limit) { - if ($data->{$field} eq $limit) { - $match = 1; - last; + for my $data_field (@data_fields) { + if ($data_field eq $limit) { + $match = 1; + last LIMIT; + } } } elsif (ref($limit) eq 'Regexp') { - if ($data->{$field} =~ $limit) { - $match = 1; - last; + for my $data_field (@data_fields) { + if ($data_field =~ $limit) { + $match = 1; + last LIMIT; + } } } else { @@ -2821,8 +3792,9 @@ sub __check_limit{ } if (not $match) { $going_to_fail = 1; - print {$transcript} "$field: '$data->{$field}' does not match at least one of ". - join(', ',map {ref($_)?'(regex)':$_} make_list($param{limit}{$field}))."\n"; + 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"; } } } @@ -2841,12 +3813,12 @@ matter.] =cut sub sig_die{ - #if ($^S) { # in eval + if ($^S) { # in eval if ($locks) { - for (1..$locks) { unfilelock(); } + for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); } $locks = 0; } - #} + } } @@ -2863,8 +3835,10 @@ sub __message_body_template{ $extra_var ||={}; my $hole_var = {'&bugurl' => sub{"$_[0]: ". - 'http://'.$config{cgi_domain}.'/'. - Debbugs::CGI::bug_url($_[0]); + $config{cgi_domain}.'/'. + Debbugs::CGI::bug_links(bug => $_[0], + links_only => 1, + ); } }; @@ -2883,6 +3857,25 @@ sub __message_body_template{ ); } +sub __all_undef_or_equal { + my @values = @_; + return 1 if @values == 1 or @values == 0; + my $not_def = grep {not defined $_} @values; + if ($not_def == @values) { + return 1; + } + if ($not_def > 0 and $not_def != @values) { + return 0; + } + my $first_val = shift @values; + for my $val (@values) { + if ($first_val ne $val) { + return 0; + } + } + return 1; +} + 1;