X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl.pm;h=4d44237aa8a0b93e0b8acc9eab7be892239ac700;hb=c72ff2efb30890213e4b6097bea521a96a72b665;hp=30a642b0bff22214fed508fa0423095e2a0f5dcf;hpb=46fa42780ecb746d7bec2fb01190b05584b9283e;p=debbugs.git diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm index 30a642b..4d44237 100644 --- a/Debbugs/Control.pm +++ b/Debbugs/Control.pm @@ -5,7 +5,7 @@ # # [Other people have contributed to this file; their copyrights should # go here too.] -# Copyright 2007 by Don Armstrong . +# Copyright 2007,2008,2009 by Don Armstrong . package Debbugs::Control; @@ -49,140 +49,2851 @@ following options: =item request_addr -- Address to which the request was sent +=item request_nn -- Name of queue file which caused this request + +=item request_msgid -- Message id of message which caused this request + =item location -- Optional location; currently ignored but may be supported in the future for updating archived bugs upon archival -=item message -- The original message which caused the action to be taken +=item message -- The original message which caused the action to be taken + +=item append_log -- Whether or not to append information to the log. + +=back + +B (for most functions) is a special option. When set to +false, no appending to the log is done at all. When it is not present, +the above information is faked, and appended to the log file. When it +is true, the above options must be present, and their values are used. + + +=head1 GENERAL FUNCTIONS + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +BEGIN{ + $VERSION = 1.00; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (done => [qw(set_done)], + submitter => [qw(set_submitter)], + severity => [qw(set_severity)], + affects => [qw(affects)], + summary => [qw(summary)], + owner => [qw(owner)], + title => [qw(set_title)], + forward => [qw(set_forwarded)], + found => [qw(set_found set_fixed)], + 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), + ], + log => [qw(append_action_to_log), + ], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + +use Debbugs::Config qw(:config); +use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions); +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); +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::MIME qw(create_mime_message); + +use Mail::RFC822::Address qw(); + +use POSIX qw(strftime); + +use Storable qw(dclone nfreeze); +use List::Util qw(first max); + +use Carp; + +# These are a set of options which are common to all of these functions + +my %common_options = (debug => {type => SCALARREF|HANDLE, + optional => 1, + }, + transcript => {type => SCALARREF|HANDLE, + optional => 1, + }, + affected_bugs => {type => HASHREF, + optional => 1, + }, + affected_packages => {type => HASHREF, + optional => 1, + }, + recipients => {type => HASHREF, + default => {}, + }, + limit => {type => HASHREF, + default => {}, + }, + show_bug_info => {type => BOOLEAN, + default => 1, + }, + request_subject => {type => SCALAR, + default => 'Unknown Subject', + }, + request_msgid => {type => SCALAR, + default => '', + }, + request_nn => {type => SCALAR, + optional => 1, + }, + request_replyto => {type => SCALAR, + optional => 1, + }, + locks => {type => HASHREF, + optional => 1, + }, + ); + + +my %append_action_options = + (action => {type => SCALAR, + optional => 1, + }, + requester => {type => SCALAR, + optional => 1, + }, + request_addr => {type => SCALAR, + optional => 1, + }, + location => {type => SCALAR, + optional => 1, + }, + message => {type => SCALAR|ARRAYREF, + optional => 1, + }, + append_log => {type => BOOLEAN, + optional => 1, + depends => [qw(requester request_addr), + 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. +# +# =head2 set_foo +# +# 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, +# ); +# }; +# if ($@) { +# $errors++; +# print {$transcript} "Failed to set foo $ref bar: $@"; +# } +# +# Foo frobinates +# +# =cut +# +# sub set_foo { +# my %param = validate_with(params => \@_, +# spec => {bug => {type => SCALAR, +# regex => qr/^\d+$/, +# }, +# # specific options here +# %common_options, +# %append_action_options, +# }, +# ); +# my %info = +# __begin_control(%param, +# command => 'foo' +# ); +# my ($debug,$transcript) = +# @info{qw(debug transcript)}; +# my @data = @{$info{data}}; +# my @bugs = @{$info{bugs}}; +# +# my $action = ''; +# for my $data (@data) { +# 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); +# } + + +=head2 set_blocks + + eval { + set_block(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + block => [], + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set blockers of $ref: $@"; + } + +Alters the set of bugs that block this bug from being fixed + +This requires altering both this bug (and those it's merged with) as +well as the bugs that block this bug from being fixed (and those that +it's merged with) + +=over + +=item block -- scalar or arrayref of blocking bugs to set, add or remove + +=item add -- if true, add blocking bugs + +=item remove -- if true, remove blocking bugs + +=back + +=cut + +sub set_blocks { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + block => {type => SCALAR|ARRAYREF, + default => [], + }, + add => {type => BOOLEAN, + default => 0, + }, + remove => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + if ($param{add} and $param{remove}) { + croak "It's nonsensical to add and remove the same blocking bugs"; + } + if (grep {$_ !~ /^\d+$/} make_list($param{block})) { + croak "Invalid blocking bug(s):". + join(', ',grep {$_ !~ /^\d+$/} make_list($param{block})); + } + my $mode = 'set'; + if ($param{add}) { + $mode = 'add'; + } + elsif ($param{remove}) { + $mode = 'remove'; + } + + my %info = + __begin_control(%param, + command => 'blocks' + ); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; + + + # The first bit of this code is ugly, and should be cleaned up. + # Its purpose is to populate %removed_blockers and %add_blockers + # with all of the bugs that should be added or removed as blockers + # of all of the bugs which are merged with $param{bug} + my %ok_blockers; + my %bad_blockers; + for my $blocker (make_list($param{block})) { + next if $ok_blockers{$blocker} or $bad_blockers{$blocker}; + my $data = read_bug(bug=>$blocker, + ); + if (defined $data and not $data->{archive}) { + $data = split_status_fields($data); + $ok_blockers{$blocker} = 1; + my @merged_bugs; + push @merged_bugs, make_list($data->{mergedwith}); + @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs; + } + else { + $bad_blockers{$blocker} = 1; + } + } + + # 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)"; + } + # 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); + return; + } + + my @change_blockers = keys %ok_blockers; + + my %removed_blockers; + my %added_blockers; + my $action = ''; + my @blockers = map {split ' ', $_->{blockedby}} @data; + my %blockers; + @blockers{@blockers} = (1) x @blockers; + + # it is nonsensical for a bug to block itself (or a merged + # partner); We currently don't allow removal because we'd possibly + # deadlock + + my %bugs; + @bugs{@bugs} = (1) x @bugs; + for my $blocker (@change_blockers) { + if ($bugs{$blocker}) { + croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker"; + } + } + @blockers = keys %blockers; + if ($param{add}) { + %removed_blockers = (); + for my $blocker (@change_blockers) { + next if exists $blockers{$blocker}; + $blockers{$blocker} = 1; + $added_blockers{$blocker} = 1; + } + } + elsif ($param{remove}) { + %added_blockers = (); + for my $blocker (@change_blockers) { + next if exists $removed_blockers{$blocker}; + delete $blockers{$blocker}; + $removed_blockers{$blocker} = 1; + } + } + else { + @removed_blockers{@blockers} = (1) x @blockers; + %blockers = (); + for my $blocker (@change_blockers) { + next if exists $blockers{$blocker}; + $blockers{$blocker} = 1; + if (exists $removed_blockers{$blocker}) { + delete $removed_blockers{$blocker}; + } + else { + $added_blockers{$blocker} = 1; + } + } + } + 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} "$data->{bug_num} was not blocked by any bugs.\n"; + } else { + 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(); + next; + } + $data->{blockedby} = join(' ',keys %blockers); + append_action_to_log(bug => $data->{bug_num}, + command => 'block', + old_data => $old_data, + new_data => $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"; + } + # we do this bit below to avoid code duplication + 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 ($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) { + 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) { + $munge_blockers{$_} = 1; + } + for my $data (@blocking_data) { + my $old_data = dclone($data); + my %blocks; + my @blocks = split ' ', $data->{blocks}; + @blocks{@blocks} = (1) x @blocks; + @blocks = (); + for my $bug (@bugs) { + if ($add_remove eq 'remove') { + next unless exists $blocks{$bug}; + delete $blocks{$bug}; + } + else { + next if exists $blocks{$bug}; + $blocks{$bug} = 1; + } + push @blocks, $bug; + } + $data->{blocks} = join(' ',sort keys %blocks); + my $action = ($add_remove eq 'add'?'Added':'Removed'). + " indication that bug $data->{bug_num} blocks ". + join(',',@blocks); + append_action_to_log(bug => $data->{bug_num}, + command => 'block', + old_data => $old_data, + new_data => $data, + get_lock => 0, + __return_append_to_log_options(%param, + action => $action + ) + ); + writebug($data->{bug_num},$data); + } + __handle_affected_packages(%param,data=>\@blocking_data); + add_recipients(recipients => $param{recipients}, + actions_taken => {blocks => 1}, + data => \@blocking_data, + debug => $debug, + transcript => $transcript, + ); + + for (1..$new_locks) { + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; + } + } + } + __end_control(%info); +} + + + +=head2 set_tag + + eval { + set_tag(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + tag => [], + add => 1, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set tag on $ref: $@"; + } + + +Sets, adds, or removes the specified tags on a bug + +=over + +=item tag -- scalar or arrayref of tags to set, add or remove + +=item add -- if true, add tags + +=item remove -- if true, remove tags + +=item warn_on_bad_tags -- if true (the default) warn if bad tags are +passed. + +=back + +=cut + +sub set_tag { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + tag => {type => SCALAR|ARRAYREF, + default => [], + }, + add => {type => BOOLEAN, + default => 0, + }, + remove => {type => BOOLEAN, + default => 0, + }, + warn_on_bad_tags => {type => BOOLEAN, + default => 1, + }, + %common_options, + %append_action_options, + }, + ); + if ($param{add} and $param{remove}) { + croak "It's nonsensical to add and remove the same tags"; + } + + my %info = + __begin_control(%param, + command => 'tag' + ); + my ($debug,$transcript) = + @info{qw(debug 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}) { + print {$transcript} "Requested to remove no tags; doing nothing.\n"; + } + else { + print {$transcript} "Requested to add no tags; doing nothing.\n"; + } + __end_control(%info); + return; + } + # first things first, make the versions fully qualified source + # versions + for my $data (@data) { + 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; + %tags = (); + } + my @bad_tags = (); + for my $tag (@tags) { + if (not $param{remove} and + not defined first {$_ eq $tag} @{$config{tags}}) { + push @bad_tags, $tag; + next; + } + if ($param{add}) { + if (not exists $tags{$tag}) { + $tags{$tag} = 1; + $tag_added{$tag} = 1; + } + } + elsif ($param{remove}) { + if (exists $tags{$tag}) { + delete $tags{$tag}; + $tag_removed{$tag} = 1; + } + } + else { + if (exists $tag_removed{$tag}) { + delete $tag_removed{$tag}; + } + else { + $tag_added{$tag} = 1; + } + $tags{$tag} = 1; + } + } + if (@bad_tags and $param{warn_on_bad_tags}) { + print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n"; + print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n"; + } + $data->{keywords} = join(' ',keys %tags); + + my @changed; + push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added; + 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(); + next; + } + $action .= '.'; + append_action_to_log(bug => $data->{bug_num}, + get_lock => 0, + command => 'tag', + old_data => $old_data, + new_data => $data, + __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); +} + + + +=head2 set_severity + + eval { + set_severity(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + severity => 'normal', + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set the severity of bug $ref: $@"; + } + +Sets the severity of a bug. If severity is not passed, is undefined, +or has zero length, sets the severity to the default severity. + +=cut + +sub set_severity { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + severity => {type => SCALAR|UNDEF, + default => $config{default_severity}, + }, + %common_options, + %append_action_options, + }, + ); + if (not defined $param{severity} or + not length $param{severity} + ) { + $param{severity} = $config{default_severity}; + } + + # check validity of new severity + if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) { + die "Severity '$param{severity}' is not a valid severity level"; + } + my %info = + __begin_control(%param, + command => 'severity' + ); + my ($debug,$transcript) = + @info{qw(debug 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}'"; + } + else { + if ($data->{severity} eq '') { + $data->{severity} = $config{default_severity}; + } + if ($data->{severity} eq $param{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}'"; + $data->{severity} = $param{severity}; + } + 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); +} + + +=head2 set_done + + eval { + 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++; + print {$transcript} "Failed to set foo $ref bar: $@"; + } + +Foo frobinates + +=cut + +sub set_done { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + 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, + }, + ); + + 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"; + } + 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 => $param{reopen}?'reopen':'done', + ); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; + my $action =''; + + 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); + } + 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) + ); + } + # 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), + ); + } + } + else { + my %submitter_notified; + my $requester_notified = 0; + 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("db-h/$hash/$data->{bug_num}.report",'r') or + die "Unable to open original report 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; + } + + $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} ($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 + ), + ); + } + } +} + + +=head2 set_submitter + + eval { + set_submitter(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + submitter => $new_submitter, + notify_submitter => 1, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set the forwarded-to-address of $ref: $@"; + } + +Sets the submitter of a bug. If notify_submitter is true (the +default), notifies the old submitter of a bug on changes + +=cut + +sub set_submitter { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + submitter => {type => SCALAR, + }, + notify_submitter => {type => BOOLEAN, + default => 1, + }, + %common_options, + %append_action_options, + }, + ); + if (not Mail::RFC822::Address::valid($param{submitter})) { + die "New submitter address $param{submitter} is not a valid e-mail address"; + } + my %info = + __begin_control(%param, + command => '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]) { + my $notify_old_submitter = 0; + my $old_data = dclone($data); + print {$debug} "Going to change bug submitter\n"; + if (((not defined $param{submitter} or not length $param{submitter}) and + (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(); + next; + } + else { + if (defined $data->{originator} and length($data->{originator})) { + $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'"; + $notify_old_submitter = 1; + } + else { + $action= "Set $config{bug} submitter to '$param{submitter}'."; + } + $data->{originator} = $param{submitter}; + } + append_action_to_log(bug => $data->{bug_num}, + command => 'submitter', + 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"; + # notify old submitter + if ($notify_old_submitter and $param{notify_submitter}) { + send_mail_message(message => + create_mime_message([default_headers(queue_file => $param{request_nn}, + data => $data, + msgid => $param{request_msgid}, + msgtype => 'ack', + pr_msg => 'submitter-changed', + headers => + [To => $old_data->{submitter}, + Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})", + ], + ) + ], + __message_body_template('mail/submitter_changed', + {old_data => $old_data, + data => $data, + replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown', + config => \%config, + }) + ), + recipients => $old_data->{submitter}, + ); + } + } + __end_control(%info); +} + + + +=head2 set_forwarded + + eval { + set_forwarded(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + forwarded => $forward_to, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set the forwarded-to-address of $ref: $@"; + } + +Sets the location to which a bug is forwarded. Given an undef +forwarded, unsets forwarded. + + +=cut + +sub set_forwarded { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + forwarded => {type => SCALAR|UNDEF, + }, + %common_options, + %append_action_options, + }, + ); + 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' + ); + 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 (__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" + unless __internal_request(); + next; + } + else { + if (not defined $param{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}'"; + } + else { + $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'."; + } + $data->{forwarded} = $param{forwarded}; + } + append_action_to_log(bug => $data->{bug_num}, + command => 'forwarded', + 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); +} + + + + +=head2 set_title + + eval { + set_title(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + title => $new_title, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set the title of $ref: $@"; + } + +Sets the title of a specific bug + + +=cut + +sub set_title { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + title => {type => SCALAR, + }, + %common_options, + %append_action_options, + }, + ); + if ($param{title} =~ /[^[:print:]]/) { + die "Non-printable characters are not allowed in bug titles"; + } + + my %info = __begin_control(%param, + command => '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(); + next; + } + else { + if (defined $data->{subject} and length($data->{subject})) { + $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'"; + } else { + $action= "Set $config{bug} title to '$param{title}'."; + } + $data->{subject} = $param{title}; + } + append_action_to_log(bug => $data->{bug_num}, + command => 'title', + 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); +} + + +=head2 set_package + + eval { + set_package(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + package => $new_package, + is_source => 0, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to assign or reassign $ref to a package: $@"; + } + +Indicates that a bug is in a particular package. If is_source is true, +indicates that the package is a source package. [Internally, this +causes src: to be prepended to the package name.] + +The default for is_source is 0. As a special case, if the package +starts with 'src:', it is assumed to be a source package and is_source +is overridden. + +The package option must match the package_name_re regex. + +=cut + +sub set_package { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + package => {type => SCALAR|ARRAYREF, + }, + is_source => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + my @new_packages = map {splitpackages($_)} make_list($param{package}); + if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) { + croak "Invalid package name '". + join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages). + "'"; + } + my %info = __begin_control(%param, + command => '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(',', + map {my $temp = $_; + ($temp =~ s/^src:// or + $param{is_source}) ? 'src:'.$temp:$temp; + } @new_packages); + + my $action = ''; + my $package_reassigned = 0; + for my $data (@data) { + my $old_data = dclone($data); + 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(); + next; + } + else { + if (defined $data->{package} and length($data->{package})) { + $package_reassigned = 1; + $action= "$config{bug} reassigned from package '$data->{package}'". + " to '$new_package'."; + } else { + $action= "$config{bug} assigned to package '$new_package'."; + } + $data->{package} = $new_package; + } + append_action_to_log(bug => $data->{bug_num}, + command => 'package', + 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); + # Only clear the fixed/found versions if the package has been + # reassigned + if ($package_reassigned) { + my @params_for_found_fixed = + map {exists $param{$_}?($_,$param{$_}):()} + ('bug', + keys %common_options, + keys %append_action_options, + ); + set_found(found => [], + @params_for_found_fixed, + ); + set_fixed(fixed => [], + @params_for_found_fixed, + ); + } +} + +=head2 set_found + + eval { + set_found(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + found => [], + add => 1, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set found on $ref: $@"; + } + + +Sets, adds, or removes the specified found versions of a package + +If the version list is empty, and the bug is currently not "done", +causes the done field to be cleared. + +If any of the versions added to found are greater than any version in +which the bug is fixed (or when the bug is found and there are no +fixed versions) the done field is cleared. + +=cut + +sub set_found { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + found => {type => SCALAR|ARRAYREF, + default => [], + }, + add => {type => BOOLEAN, + default => 0, + }, + remove => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + if ($param{add} and $param{remove}) { + croak "It's nonsensical to add and remove the same versions"; + } + + my %info = + __begin_control(%param, + command => '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; + $versions{$version} = + [make_source_versions(package => [splitpackages($data[0]{package})], + warnings => $transcript, + debug => $debug, + guess_source => 0, + versions => $version, + ) + ]; + # This is really ugly, but it's what we have to do + if (not @{$versions{$version}}) { + print {$transcript} "Unable to make a source version for version '$version'\n"; + } + } + if (not keys %versions and ($param{remove} or $param{add})) { + if ($param{remove}) { + print {$transcript} "Requested to remove no versions; doing nothing.\n"; + } + else { + print {$transcript} "Requested to add no versions; doing nothing.\n"; + } + __end_control(%info); + return; + } + # first things first, make the versions fully qualified source + # versions + for my $data (@data) { + # The 'done' field gets a bit weird with version tracking, + # because a bug may be closed by multiple people in different + # branches. Until we have something more flexible, we set it + # every time a bug is fixed, and clear it when a bug is found + # in a version greater than any version in which the bug is + # fixed or when a bug is found and there is no fixed version + my $action = 'Did not alter found versions'; + my %found_added = (); + my %found_removed = (); + my %fixed_removed = (); + my $reopened = 0; + my $old_data = dclone($data); + if (not $param{add} and not $param{remove}) { + $found_removed{$_} = 1 for @{$data->{found_versions}}; + $data->{found_versions} = []; + } + my %found_versions; + @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}}; + my %fixed_versions; + @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}}; + for my $version (keys %versions) { + if ($param{add}) { + my @svers = @{$versions{$version}}; + if (not @svers) { + @svers = $version; + } + for my $sver (@svers) { + if (not exists $found_versions{$sver}) { + $found_versions{$sver} = 1; + $found_added{$sver} = 1; + } + # if the found we are adding matches any fixed + # versions, remove them + my @temp = grep m{(^|/)\Q$sver\E}, keys %fixed_versions; + delete $fixed_versions{$_} for @temp; + $fixed_removed{$_} = 1 for @temp; + } + + # 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_versions(map {m{([^/]+)$}; $1;} + @svers); + # determine if we need to reopen + 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; + $data->{done} = ''; + } + } + } + elsif ($param{remove}) { + # 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; + delete $found_versions{$_} for @temp; + $found_removed{$_} = 1 for @temp; + } + else { + # set the keys to exactly these values + my @svers = @{$versions{$version}}; + if (not @svers) { + @svers = $version; + } + for my $sver (@svers) { + if (not exists $found_versions{$sver}) { + $found_versions{$sver} = 1; + if (exists $found_removed{$sver}) { + delete $found_removed{$sver}; + } + else { + $found_added{$sver} = 1; + } + } + } + } + } + + $data->{found_versions} = [keys %found_versions]; + $data->{fixed_versions} = [keys %fixed_versions]; + + my @changed; + push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added; + 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 = 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(); + next; + } + $action .= '.'; + append_action_to_log(bug => $data->{bug_num}, + get_lock => 0, + command => 'found', + old_data => $old_data, + new_data => $data, + __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); +} + +=head2 set_fixed + + eval { + set_fixed(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + fixed => [], + add => 1, + reopen => 0, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set fixed on $ref: $@"; + } + + +Sets, adds, or removes the specified fixed versions of a package + +If the fixed versions are empty (or end up being empty after this +call) or the greatest fixed version is less than the greatest found +version and the reopen option is true, the bug is reopened. + +This function is also called by the reopen function, which causes all +of the fixed versions to be cleared. + +=cut + +sub set_fixed { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + fixed => {type => SCALAR|ARRAYREF, + default => [], + }, + add => {type => BOOLEAN, + default => 0, + }, + remove => {type => BOOLEAN, + default => 0, + }, + reopen => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + if ($param{add} and $param{remove}) { + croak "It's nonsensical to add and remove the same versions"; + } + my %info = + __begin_control(%param, + command => '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; + $versions{$version} = + [make_source_versions(package => [splitpackages($data[0]{package})], + warnings => $transcript, + debug => $debug, + guess_source => 0, + versions => $version, + ) + ]; + # This is really ugly, but it's what we have to do + if (not @{$versions{$version}}) { + print {$transcript} "Unable to make a source version for version '$version'\n"; + } + } + if (not keys %versions and ($param{remove} or $param{add})) { + if ($param{remove}) { + print {$transcript} "Requested to remove no versions; doing nothing.\n"; + } + else { + print {$transcript} "Requested to add no versions; doing nothing.\n"; + } + __end_control(%info); + return; + } + # first things first, make the versions fully qualified source + # versions + for my $data (@data) { + my $old_data = dclone($data); + # The 'done' field gets a bit weird with version tracking, + # because a bug may be closed by multiple people in different + # branches. Until we have something more flexible, we set it + # every time a bug is fixed, and clear it when a bug is found + # in a version greater than any version in which the bug is + # fixed or when a bug is found and there is no fixed version + my $action = 'Did not alter fixed versions'; + my %found_added = (); + my %found_removed = (); + my %fixed_added = (); + my %fixed_removed = (); + my $reopened = 0; + if (not $param{add} and not $param{remove}) { + $fixed_removed{$_} = 1 for @{$data->{fixed_versions}}; + $data->{fixed_versions} = []; + } + my %found_versions; + @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]}; + my %fixed_versions; + @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]}; + for my $version (keys %versions) { + if ($param{add}) { + my @svers = @{$versions{$version}}; + if (not @svers) { + @svers = $version; + } + for my $sver (@svers) { + if (not exists $fixed_versions{$sver}) { + $fixed_versions{$sver} = 1; + $fixed_added{$sver} = 1; + } + } + } + elsif ($param{remove}) { + # 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 %fixed_versions; + delete $fixed_versions{$_} for @temp; + $fixed_removed{$_} = 1 for @temp; + } + else { + # set the keys to exactly these values + my @svers = @{$versions{$version}}; + if (not @svers) { + @svers = $version; + } + for my $sver (@svers) { + if (not exists $fixed_versions{$sver}) { + $fixed_versions{$sver} = 1; + if (exists $fixed_removed{$sver}) { + delete $fixed_removed{$sver}; + } + else { + $fixed_added{$sver} = 1; + } + } + } + } + } + + $data->{found_versions} = [keys %found_versions]; + $data->{fixed_versions} = [keys %fixed_versions]; + + # If we're supposed to consider reopening, reopen if the + # fixed versions are empty or the greatest found version + # is greater than the greatest fixed version + if ($param{reopen} and defined $data->{done} + and length $data->{done}) { + my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);} + map {m{([^/]+)$}; $1;} @{$data->{found_versions}}; + # determine if we need to reopen + my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);} + map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}}; + if (not @fixed_order or + (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) { + $reopened = 1; + $data->{done} = ''; + } + } + + my @changed; + push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added; + 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 = 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(); + next; + } + $action .= '.'; + append_action_to_log(bug => $data->{bug_num}, + command => 'fixed', + 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); +} + + +=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 @bugs = @{$info{bugs}}; + 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}) { + 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"; + __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 @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, + 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->{orig_value}' not '$change->{value}'\n"; + } + if ($attempts > 0) { + croak "Some bugs were altered while attempting to merge"; + } + else { + croak "Did not alter merged bugs"; + } + } + my ($change_bug) = keys %{$changes}; + $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; + my @blocks_to_remove; + 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}); + ($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} "Unable to modify bugs so that they could be merged\n"; + for (1..$new_locks) { + unfilelock($param{locks}); + $locks--; + } + __end_control(%info); + 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) = @_; + + for my $bug (@{$bugs}) { + my @lockfiles = grep {m{/\Q$bug\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) = @_; + my %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 affects)) { + $merge_status{$_} = $data->{$_} + } + } + if (not $merge) { + 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"}}; + } + } + 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 => [], + }, + 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 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 ($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} ? 0 : $force_functions{$field}{allowed}, + }; + if ($param->{force}) { + if ($field ne 'package') { + 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 + + eval { + affects(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + packages => undef, + add => 1, + remove => 0, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to mark $ref as affecting $packages: $@"; + } + +This marks a bug as affecting packages which the bug is not actually +in. This should only be used in cases where fixing the bug instantly +resolves the problem in the other packages. + +By default, the packages are set to the list of packages passed. +However, if you pass add => 1 or remove => 1, the list of packages +passed are added or removed from the affects list, respectively. + +=cut + +sub affects { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + package => {type => SCALAR|ARRAYREF|UNDEF, + default => [], + }, + add => {type => BOOLEAN, + default => 0, + }, + remove => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + 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' + ); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; + my $action = ''; + for my $data (@data) { + $action = ''; + print {$debug} "Going to change affects\n"; + my @packages = splitpackages($data->{affects}); + my %packages; + @packages{@packages} = (1) x @packages; + if ($param{add}) { + my @added = (); + for my $package (make_list($param{package})) { + next unless defined $package and length $package; + if (not $packages{$package}) { + $packages{$package} = 1; + push @added,$package; + } + } + if (@added) { + $action = "Added indication that $data->{bug_num} affects ". + english_join(\@added); + } + } + elsif ($param{remove}) { + my @removed = (); + for my $package (make_list($param{package})) { + if ($packages{$package}) { + next unless defined $package and length $package; + delete $packages{$package}; + push @removed,$package; + } + } + $action = "Removed indication that $data->{bug_num} affects " . + english_join(\@removed); + } + else { + my %added_packages = (); + my %removed_packages = %packages; + %packages = (); + for my $package (make_list($param{package})) { + next unless defined $package and length $package; + $packages{$package} = 1; + delete $removed_packages{$package}; + $added_packages{$package} = 1; + } + if (keys %removed_packages) { + $action = "Removed indication that $data->{bug_num} affects ". + english_join([keys %removed_packages]); + $action .= "\n" if keys %added_packages; + } + if (keys %added_packages) { + $action .= "Added indication that $data->{bug_num} affects " . + english_join([keys %added_packages]); + } + } + 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(); + next; + } + my $old_data = dclone($data); + $data->{affects} = join(',',keys %packages); + append_action_to_log(bug => $data->{bug_num}, + get_lock => 0, + command => 'affects', + new_data => $data, + old_data => $old_data, + __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); +} + -=item append_log -- Whether or not to append information to the log. +=head1 SUMMARY FUNCTIONS -=back +=head2 summary -B (for most functions) is a special option. When set to -false, no appending to the log is done at all. When it is not present, -the above information is faked, and appended to the log file. When it -is true, the above options must be present, and their values are used. + eval { + summary(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + summary => undef, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to mark $ref with summary foo: $@"; + } +Handles all setting of summary fields -=head1 GENERAL FUNCTIONS +If summary is undef, unsets the summary -=cut +If summary is 0, sets the summary to the first paragraph contained in +the message passed. -use warnings; -use strict; -use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); -use base qw(Exporter); +If summary is a positive integer, sets the summary to the message specified. -BEGIN{ - $VERSION = 1.00; - $DEBUG = 0 unless defined $DEBUG; +Otherwise, sets summary to the value passed. - @EXPORT = (); - %EXPORT_TAGS = (owner => [qw(owner)], - archive => [qw(bug_archive bug_unarchive), - ], - log => [qw(append_action_to_log), - ], - ); - @EXPORT_OK = (); - Exporter::export_ok_tags(keys %EXPORT_TAGS); - $EXPORT_TAGS{all} = [@EXPORT_OK]; -} +=cut -use Debbugs::Config qw(:config); -use Debbugs::Common qw(:lock buglog :misc get_hashname); -use Debbugs::Status qw(bug_archiveable :read :hook writebug); -use Debbugs::CGI qw(html_escape); -use Debbugs::Log qw(:misc); -use Debbugs::Recipients qw(:add); -use Params::Validate qw(validate_with :types); -use File::Path qw(mkpath); -use IO::File; +sub summary { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + summary => {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' + ); + 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}) { + # do nothing + print {$debug} "Removing summary fields\n"; + $action = 'Removed summary'; + } + elsif ($param{summary} =~ /^\d+$/) { + my $log = []; + my @records = Debbugs::Log::read_log_records(bug_num => $param{bug}); + if ($param{summary} == 0) { + $log = $param{message}; + $summary_msg = @records + 1; + } + else { + if (($param{summary} - 1 ) > $#records) { + die "Message number '$param{summary}' exceeds the maximum message '$#records'"; + } + my $record = $records[($param{summary} - 1 )]; + if ($record->{type} !~ /incoming-recv|recips/) { + die "Message number '$param{summary}' is a invalid message type '$record->{type}'"; + } + $summary_msg = $param{summary}; + $log = [$record->{text}]; + } + my $p_o = Debbugs::MIME::parse(join('',@{$log})); + my $body = $p_o->{body}; + my $in_pseudoheaders = 0; + my $paragraph = ''; + # walk through body until we get non-blank lines + for my $line (@{$body}) { + if ($line =~ /^\s*$/) { + if (length $paragraph) { + if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) { + $paragraph = ''; + next; + } + last; + } + $in_pseudoheaders = 0; + next; + } + # 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 + $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 + (?:un|force|)merge|user(?:category|tags?|) + )\s+\S}xis) { + if (not length $paragraph) { + print {$debug} "Found control/pseudo-headers and skiping them\n"; + $in_pseudoheaders = 1; + next; + } + } + next if $in_pseudoheaders; + $paragraph .= $line ." \n"; + } + print {$debug} "Summary 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"; + } + # trim off a trailing spaces + $summary =~ s/\ *$//; + } + else { + $summary = $param{summary}; + } + for my $data (@data) { + print {$debug} "Going to change summary\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(); + next; + } + if (length $summary) { + if (length $data->{summary}) { + $action = "Summary replaced with message bug $param{bug} message $summary_msg"; + } + else { + $action = "Summary recorded from message bug $param{bug} message $summary_msg"; + } + } + my $old_data = dclone($data); + $data->{summary} = $summary; + append_action_to_log(bug => $data->{bug_num}, + command => 'summary', + old_data => $old_data, + new_data => $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); +} -use Debbugs::Text qw(:templates); -use Debbugs::Mail qw(rfc822_date); -use POSIX qw(strftime); +=head2 clone_bug -use Carp; + 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: $@"; + } -# These are a set of options which are common to all of these functions +Clones the given bug. -my %common_options = (debug => {type => SCALARREF|HANDLE, - optional => 1, - }, - transcript => {type => SCALARREF|HANDLE, - optional => 1, - }, - affected_bugs => {type => HASHREF, - optional => 1, - }, - affected_packages => {type => HASHREF, - optional => 1, - }, - recipients => {type => HASHREF, - default => {}, - }, - limit => {type => HASHREF, - default => {}, - }, - ); +We currently don't support cloning merged bugs, but this could be +handled by internally unmerging, cloning, then remerging the bugs. +=cut -my %append_action_options = - (action => {type => SCALAR, - optional => 1, - }, - requester => {type => SCALAR, - optional => 1, - }, - request_addr => {type => SCALAR, - optional => 1, - }, - location => {type => SCALAR, - optional => 1, - }, - message => {type => SCALAR|ARRAYREF, - optional => 1, - }, - append_log => {type => BOOLEAN, - optional => 1, - depends => [qw(requester request_addr), - qw(message), - ], - }, - ); +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 ($debug,$transcript) = + @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; + + 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 => $new_bug, + blocks => $bug, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } + # bugs that this bug is blocked by are also blocking the new clone(s) + for my $bug (split ' ', $data->{blockedby}) { + for my $new_bug (@new_bugs) { + set_blocks(bug => $bug, + blocks => $new_bug, + hash_slice(%param, + keys %common_options, + keys %append_action_options), + ); + } + } +} -# this is just a generic stub for Debbugs::Control functions. -# sub foo { -# my %param = validate_with(params => \@_, -# spec => {bug => {type => SCALAR, -# regex => qr/^\d+$/, -# }, -# # specific options here -# %common_options, -# %append_action_options, -# }, -# ); -# our $locks = 0; -# $locks = 0; -# local $SIG{__DIE__} = sub { -# if ($locks) { -# for (1..$locks) { unfilelock(); } -# $locks = 0; -# } -# }; -# my ($debug,$transcript) = __handle_debug_transcript(%param); -# my (@data); -# ($locks, @data) = lock_read_all_merged_bugs($param{bug}); -# __handle_affected_packages(data => \@data,%param); -# add_recipients(data => \@data, -# recipients => $param{recipients} -# ); -# } =head1 OWNER FUNCTIONS @@ -220,41 +2931,46 @@ sub owner { %append_action_options, }, ); - our $locks = 0; - $locks = 0; - local $SIG{__DIE__} = sub { - if ($locks) { - for (1..$locks) { unfilelock(); } - $locks = 0; - } - }; - my ($debug,$transcript) = __handle_debug_transcript(%param); - my (@data); - ($locks, @data) = lock_read_all_merged_bugs($param{bug}); - __handle_affected_packages(data => \@data,%param); - @data and defined $data[0] or die "No bug found for $param{bug}"; - add_recipients(data => \@data, - recipients => $param{recipients} - ); + my %info = + __begin_control(%param, + command => '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}) { - $param{owner} = ''; - $action = "Removed annotation that $config{bug} was owned by " . - "$data->{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(); + next; + } + $param{owner} = ''; + $action = "Removed annotation that $config{bug} was owned by " . + "$data->{owner}."; } else { - if (length $data->{owner}) { - $action = "Owner changed from $data->{owner} to $param{owner}."; - } - else { - $action = "Owner recorded as $param{owner}." - } + if ($data->{owner} eq $param{owner}) { + print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n"; + next; + } + if (length $data->{owner}) { + $action = "Owner changed from $data->{owner} to $param{owner}."; + } + else { + $action = "Owner recorded as $param{owner}." + } } + my $old_data = dclone($data); $data->{owner} = $param{owner}; append_action_to_log(bug => $data->{bug_num}, + command => 'owner', + new_data => $data, + old_data => $old_data, get_lock => 0, __return_append_to_log_options( %param, @@ -264,13 +2980,8 @@ sub owner { if not exists $param{append_log} or $param{append_log}; writebug($data->{bug_num},$data); print {$transcript} "$action\n"; - add_recipients(data => $data, - recipients => $param{recipients}, - ); - } - if ($locks) { - for (1..$locks) { unfilelock(); } } + __end_control(%info); } @@ -332,16 +3043,13 @@ sub bug_archive { %append_action_options, }, ); - our $locks = 0; - $locks = 0; - local $SIG{__DIE__} = sub { - if ($locks) { - for (1..$locks) { unfilelock(); } - $locks = 0; - } - }; + my %info = __begin_control(%param, + command => 'archive', + ); + my ($debug,$transcript) = @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; my $action = "$config{bug} archived."; - my ($debug,$transcript) = __handle_debug_transcript(%param); if ($param{check_archiveable} and not bug_archiveable(bug=>$param{bug}, ignore_time => $param{ignore_time}, @@ -350,13 +3058,6 @@ sub bug_archive { die "Bug $param{bug} cannot be archived"; } print {$debug} "$param{bug} considering\n"; - my (@data); - ($locks, @data) = lock_read_all_merged_bugs($param{bug}); - __handle_affected_packages(data => \@data,%param); - print {$debug} "$param{bug} read $locks\n"; - @data and defined $data[0] or die "No bug found for $param{bug}"; - print {$debug} "$param{bug} read done\n"; - if (not $param{archive_unarchived} and not exists $data[0]{unarchived} ) { @@ -365,8 +3066,9 @@ sub bug_archive { } add_recipients(recipients => $param{recipients}, data => \@data, + debug => $debug, + transcript => $transcript, ); - my @bugs = map {$_->{bug_num}} @data; print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; for my $bug (@bugs) { if ($param{check_archiveable}) { @@ -384,6 +3086,12 @@ sub bug_archive { # First indicate that this bug is being archived append_action_to_log(bug => $bug, get_lock => 0, + command => 'archive', + # we didn't actually change the data + # when we archived, so we don't pass + # a real new_data or old_data + new_data => {}, + old_data => {}, __return_append_to_log_options( %param, action => $action, @@ -394,24 +3102,21 @@ sub bug_archive { if ($config{save_old_bugs}) { mkpath("$config{spool_dir}/archive/$dir"); foreach my $file (@files_to_remove) { - link( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ) or - copy( "$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file" ); + link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or + copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or + # we need to bail out here if things have + # gone horribly wrong to avoid removing a + # bug altogether + die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!"; } 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); - if (exists $param{bugs_affected}) { - @{$param{bugs_affected}}{@bugs} = (1) x @bugs; - } - print {$debug} "$param{bug} unlocking $locks\n"; - if ($locks) { - for (1..$locks) { unfilelock(); } - } - print {$debug} "$param{bug} unlocking done\n"; + __end_control(%info); } =head2 bug_unarchive @@ -442,28 +3147,15 @@ sub bug_unarchive { %append_action_options, }, ); - our $locks = 0; - local $SIG{__DIE__} = sub { - if ($locks) { - for (1..$locks) { unfilelock(); } - $locks = 0; - } - }; + + my %info = __begin_control(%param, + archived=>1, + command=>'unarchive'); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; my $action = "$config{bug} unarchived."; - my ($debug,$transcript) = __handle_debug_transcript(%param); - print {$debug} "$param{bug} considering\n"; - my @data = (); - ($locks, @data) = lock_read_all_merged_bugs($param{bug},'archive'); - __handle_affected_packages(data => \@data,%param); - print {$debug} "$param{bug} read $locks\n"; - if (not @data or not defined $data[0]) { - print {$transcript} "No bug found for $param{bug}\n"; - die "No bug found for $param{bug}"; - } - print {$debug} "$param{bug} read done\n"; - my @bugs = map {$_->{bug_num}} @data; - print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; - print {$debug} "$param{bug} unarchiving\n"; my @files_to_remove; for my $bug (@bugs) { print {$debug} "$param{bug} removing $bug\n"; @@ -483,6 +3175,7 @@ sub bug_unarchive { # Indicate that this bug has been archived previously for my $bug (@bugs) { my $newdata = readbug($bug); + my $old_data = dclone($newdata); if (not defined $newdata) { print {$transcript} "$config{bug} $bug disappeared!\n"; die "Bug $bug disappeared!"; @@ -490,6 +3183,9 @@ sub bug_unarchive { $newdata->{unarchived} = time; append_action_to_log(bug => $bug, get_lock => 0, + command => 'unarchive', + new_data => $newdata, + old_data => $old_data, __return_append_to_log_options( %param, action => $action, @@ -497,18 +3193,8 @@ sub bug_unarchive { ) if not exists $param{append_log} or $param{append_log}; writebug($bug,$newdata); - add_recipients(recipients => $param{recipients}, - data => $newdata, - ); - } - print {$debug} "$param{bug} unlocking $locks\n"; - if ($locks) { - for (1..$locks) { unfilelock(); }; - } - if (exists $param{bugs_affected}) { - @{$param{bugs_affected}}{@bugs} = (1) x @bugs; } - print {$debug} "$param{bug} unlocking done\n"; + __end_control(%info); } =head2 append_action_to_log @@ -525,42 +3211,184 @@ sub append_action_to_log{ spec => {bug => {type => SCALAR, regex => qr/^\d+/, }, + new_data => {type => HASHREF, + optional => 1, + }, + old_data => {type => HASHREF, + optional => 1, + }, + command => {type => SCALAR, + optional => 1, + }, action => {type => SCALAR, }, requester => {type => SCALAR, + default => '', }, request_addr => {type => SCALAR, + default => '', }, location => {type => SCALAR, optional => 1, }, 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 + # options aren't actually + # optional, even though the + # original function doesn't + # require them + }, ); # Fix this to use $param{location} my $log_location = buglog($param{bug}); 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 @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}) { + my $old_data = dclone($param{old_data}); + my $new_data = dclone($param{new_data}); + for my $key (keys %{$old_data}) { + if (not exists $Debbugs::Status::fields{$key}) { + delete $old_data->{$key}; + next; + } + next unless exists $new_data->{$key}; + next unless defined $new_data->{$key}; + if (not defined $old_data->{$key}) { + delete $old_data->{$key}; + next; + } + if (ref($new_data->{$key}) and + ref($old_data->{$key}) and + ref($new_data->{$key}) eq ref($old_data->{$key})) { + local $Storable::canonical = 1; + if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) { + delete $new_data->{$key}; + delete $old_data->{$key}; + } + } + elsif ($new_data->{$key} eq $old_data->{$key}) { + delete $new_data->{$key}; + delete $old_data->{$key}; + } + } + for my $key (keys %{$new_data}) { + if (not exists $Debbugs::Status::fields{$key}) { + delete $new_data->{$key}; + next; + } + next unless exists $old_data->{$key}; + next unless defined $old_data->{$key}; + if (not defined $new_data->{$key} or + not exists $Debbugs::Status::fields{$key}) { + delete $new_data->{$key}; + next; + } + if (ref($new_data->{$key}) and + ref($old_data->{$key}) and + ref($new_data->{$key}) eq ref($old_data->{$key})) { + local $Storable::canonical = 1; + if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) { + delete $new_data->{$key}; + delete $old_data->{$key}; + } + } + elsif ($new_data->{$key} eq $old_data->{$key}) { + delete $new_data->{$key}; + delete $old_data->{$key}; + } + } + $data_diff .= "\n"; + $data_diff .= "\n"; + } + my $msg = join('', + (exists $param{command} ? + "\n":"" + ), + (length $param{requester} ? + "\n":"" + ), + (length $param{request_addr} ? + "\n":"" + ), + "\n", + $data_diff, + "".html_escape($param{action})."\n"); + if (length $param{requester}) { + $msg .= "Request was from ".html_escape($param{requester})."\n"; + } + if (length $param{request_addr}) { + $msg .= "to ".html_escape($param{request_addr}).""; + } + if (length $param{desc}) { + $msg .= ":
\n$param{desc}\n"; + } + else { + $msg .= ".\n"; + } + push @records, {type => 'html', + text => $msg, + }; + $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})]):(), + text => join('',make_list($param{message})), + }; } - my $log = IO::File->new(">>$log_location") or - die "Unable to open $log_location for appending: $!"; - print {$log} "\6\n". - "\n". - "".html_escape($param{action})."\n". - "Request was from ".html_escape($param{requester})."\n". - "to ".html_escape($param{request_addr}).". \n". - "\3\n". - "\7\n",escape_log(make_list($param{message})),"\n\3\n" - 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}) { - unlockfile(); + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; } @@ -588,8 +3416,10 @@ sub __handle_affected_packages{ allow_extra => 1, ); for my $data (make_list($param{data})) { - $param{affected_packages}{$data->{package}} = 1; - } + next unless exists $data->{package} and defined $data->{package}; + my @packages = split /\s*,\s*/,$data->{package}; + @{$param{affected_packages}}{@packages} = (1) x @packages; + } } =head2 __handle_debug_transcript @@ -611,6 +3441,56 @@ sub __handle_debug_transcript{ return ($debug,$transcript); } +=head2 __bug_info + + __bug_info($data) + +Produces a small bit of bug information to kick out to the transcript + +=cut + +sub __bug_info{ + my $return = ''; + for my $data (@_) { + next unless defined $data and exists $data->{bug_num}; + $return .= "Bug #".($data->{bug_num}||''). + ((defined $data->{done} and length $data->{done})? + " {Done: $data->{done}}":'' + ). + " [".($data->{package}||'(no package)'). "] ". + ($data->{subject}||'(no subject)')."\n"; + } + return $return; +} + + +=head2 __internal_request + + __internal_request() + __internal_request($level) + +Returns true if the caller of the function calling __internal_request +belongs to __PACKAGE__ + +This allows us to be magical, and don't bother to print bug info if +the second caller is from this package, amongst other things. + +An optional level is allowed, which increments the number of levels to +check by the given value. [This is basically for use by internal +functions like __begin_control which are always called by +C<__PACKAGE__>. + +=cut + +sub __internal_request{ + my ($l) = @_; + $l = 0 if not defined $l; + if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) { + return 1; + } + return 0; +} + sub __return_append_to_log_options{ my %param = @_; my $action = $param{action} if exists $param{action}; @@ -635,11 +3515,302 @@ sub __return_append_to_log_options{ $action = "unknown action"; } return (action => $action, - (map {exists $append_action_options{$_}?($_,$param{$_}):()} - keys %param), + hash_slice(%param,keys %append_action_options), ); } +=head2 __begin_control + + my %info = __begin_control(%param, + archived=>1, + command=>'unarchive'); + my ($debug,$transcript) = @info{qw(debug transcript)}; + my @data = @{$info{data}}; + my @bugs = @{$info{bugs}}; + + +Starts the process of modifying a bug; handles all of the generic +things that almost every control request needs + +Returns a hash containing + +=over + +=item new_locks -- number of new locks taken out by this call + +=item debug -- the debug file handle + +=item transcript -- the transcript file handle + +=item data -- an arrayref containing the data of the bugs +corresponding to this request + +=item bugs -- an arrayref containing the bug numbers of the bugs +corresponding to this request + +=back + +=cut + +our $lockhash; + +sub __begin_control { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+/, + }, + archived => {type => BOOLEAN, + default => 0, + }, + command => {type => SCALAR, + optional => 1, + }, + %common_options, + }, + allow_extra => 1, + ); + my $new_locks; + my ($debug,$transcript) = __handle_debug_transcript(@_); + print {$debug} "$param{bug} considering\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(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."; + } + if (not $param{archived}) { + for my $data (@data) { + if ($data->{archived}) { + die "Not altering archived bugs; see unarchive."; + } + } + } + if (not __check_limit(data => \@data, + exists $param{limit}?(limit => $param{limit}):(), + transcript => $transcript, + )) { + die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data); + } + + __handle_affected_packages(%param,data => \@data); + print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1); + print {$debug} "$param{bug} read $locks locks\n"; + if (not @data or not defined $data[0]) { + print {$transcript} "No bug found for $param{bug}\n"; + die "No bug found for $param{bug}"; + } + + add_recipients(data => \@data, + recipients => $param{recipients}, + (exists $param{command}?(actions_taken => {$param{command} => 1}):()), + debug => $debug, + (__internal_request()?(transcript => $transcript):()), + ); + + print {$debug} "$param{bug} read done\n"; + my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data; + print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; + return (data => \@data, + bugs => \@bugs, + old_die => $old_die, + new_locks => $new_locks, + debug => $debug, + transcript => $transcript, + param => \%param, + exists $param{locks}?(locks => $param{locks}):(), + ); +} + +=head2 __end_control + + __end_control(%info); + +Handles tearing down from a control request + +=cut + +sub __end_control { + my %info = @_; + 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(exists $info{locks}?$info{locks}:()); + $locks--; + } + } + $SIG{__DIE__} = $info{old_die}; + 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}):()), + data => $info{data}, + debug => $info{debug}, + transcript => $info{transcript}, + ); + __handle_affected_packages(%{$info{param}},data=>$info{data}); +} + + +=head2 __check_limit + + __check_limit(data => \@data, limit => $param{limit}); + + +Checks to make sure that bugs match any limits; each entry of @data +much satisfy the limit. + +Returns true if there are no entries in data, or there are no keys in +limit; returns false (0) if there are any entries which do not match. + +The limit hashref elements can contain an arrayref of scalars to +match; regexes are also acccepted. At least one of the entries in each +element needs to match the corresponding field in all data for the +limit to succeed. + +=cut + + +sub __check_limit{ + my %param = validate_with(params => \@_, + spec => {data => {type => ARRAYREF|SCALAR, + }, + limit => {type => HASHREF|UNDEF, + }, + transcript => {type => SCALARREF|HANDLE, + optional => 1, + }, + }, + ); + my @data = make_list($param{data}); + if (not @data or + not defined $param{limit} or + not keys %{$param{limit}}) { + return 1; + } + 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; + my @data_fields = make_list($data->{$field}); +LIMIT: for my $limit (make_list($param{limit}{$field})) { + if (not ref $limit) { + for my $data_field (@data_fields) { + if ($data_field eq $limit) { + $match = 1; + last LIMIT; + } + } + } + elsif (ref($limit) eq 'Regexp') { + for my $data_field (@data_fields) { + if ($data_field =~ $limit) { + $match = 1; + last LIMIT; + } + } + } + else { + warn "Unknown type of reference: '".ref($limit)."' in key '$field'"; + } + } + if (not $match) { + $going_to_fail = 1; + 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"; + } + } + } + return $going_to_fail?0:1; +} + + +=head2 die + + sig_die "foo" + +We override die to specially handle unlocking files in the cases where +we are called via eval. [If we're not called via eval, it doesn't +matter.] + +=cut + +sub sig_die{ + if ($^S) { # in eval + if ($locks) { + for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); } + $locks = 0; + } + } +} + + +# =head2 __message_body_template +# +# message_body_template('mail/ack',{ref=>'foo'}); +# +# Creates a message body using a template +# +# =cut + +sub __message_body_template{ + my ($template,$extra_var) = @_; + $extra_var ||={}; + my $hole_var = {'&bugurl' => + sub{"$_[0]: ". + 'http://'.$config{cgi_domain}.'/'. + Debbugs::CGI::bug_url($_[0]); + } + }; + + my $body = fill_in_template(template => $template, + variables => {config => \%config, + %{$extra_var}, + }, + hole_var => $hole_var, + ); + return fill_in_template(template => 'mail/message_body', + variables => {config => \%config, + %{$extra_var}, + body => $body, + }, + hole_var => $hole_var, + ); +} + +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;