optional => 1,
},
repeat_merged => {type => BOOLEAN,
- optional => 1,
+ default => 1,
},
include => {type => HASHREF,
optional => 1,
@EXPORT = ();
%EXPORT_TAGS = (util => [qw(getbugcomponent getbuglocation getlocationpath get_hashname),
- qw(appendfile buglog getparsedaddrs getmaintainers),
+ qw(appendfile overwritefile buglog getparsedaddrs getmaintainers),
qw(bug_status),
qw(getmaintainers_reverse),
qw(getpseudodesc),
],
misc => [qw(make_list globify_scalar english_join checkpid),
qw(cleanup_eval_fail),
+ qw(hash_slice),
],
date => [qw(secs_to_english)],
quit => [qw(quit)],
#use Debbugs::Config qw(:globals);
use Carp;
+$Carp::Verbose = 1;
use Debbugs::Config qw(:config);
use IO::File;
use Params::Validate qw(validate_with :types);
-use Fcntl qw(:flock);
+use Fcntl qw(:DEFAULT :flock);
our $DEBUG_FH = \*STDERR if not defined $DEBUG_FH;
close $fh or die "Unable to close $file: $!";
}
+=head2 overwritefile
+
+ ovewritefile($file,'data','to','append');
+
+Opens file.new, writes data to it, then moves file.new to file.
+
+=cut
+
+sub overwritefile {
+ my ($file,@data) = @_;
+ my $fh = IO::File->new("${file}.new",'w') or
+ die "Unable top open ${file}.new for writing: $!";
+ print {$fh} @data or die "Unable to write to ${file}.new: $!";
+ close $fh or die "Unable to close ${file}.new: $!";
+ rename("${file}.new",$file) or
+ die "Unable to rename ${file}.new to $file: $!";
+}
+
+
+
+
+
=head2 getparsedaddrs
my $address = getparsedaddrs($address);
=head2 filelock
- filelock
+ filelock($lockfile);
+ filelock($lockfile,$locks);
FLOCKs the passed file. Use unfilelock to unlock it.
+Can be passed an optional $locks hashref, which is used to track which
+files are locked (and how many times they have been locked) to allow
+for cooperative locking.
+
=cut
our @filelocks;
+use Carp qw(cluck);
+
sub filelock {
# NB - NOT COMPATIBLE WITH `with-lock'
- my ($lockfile) = @_;
+ my ($lockfile,$locks) = @_;
if ($lockfile !~ m{^/}) {
$lockfile = cwd().'/'.$lockfile;
}
+ # This is only here to allow for relocking bugs inside of
+ # Debbugs::Control. Nothing else should be using it.
+ if (defined $locks and exists $locks->{locks}{$lockfile} and
+ $locks->{locks}{$lockfile} >= 1) {
+ if (exists $locks->{relockable} and
+ exists $locks->{relockable}{$lockfile}) {
+ $locks->{locks}{$lockfile}++;
+ # indicate that the bug for this lockfile needs to be reread
+ $locks->{relockable}{$lockfile} = 1;
+ push @{$locks->{lockorder}},$lockfile;
+ return;
+ }
+ else {
+ use Data::Dumper;
+ confess "Locking already locked file: $lockfile\n".Data::Dumper->Dump([$lockfile,$locks],[qw(lockfile locks)]);
+ }
+ }
my ($count,$errors);
$count= 10; $errors= '';
for (;;) {
}
if ($fh) {
push @filelocks, {fh => $fh, file => $lockfile};
+ if (defined $locks) {
+ $locks->{locks}{$lockfile}++;
+ push @{$locks->{lockorder}},$lockfile;
+ }
last;
}
if (--$count <=0) {
$errors =~ s/\n+$//;
- die "failed to get lock on $lockfile -- $errors";
+ use Data::Dumper;
+ croak "failed to get lock on $lockfile -- $errors".
+ (defined $locks?Data::Dumper->Dump([$locks],[qw(locks)]):'');
}
- sleep 10;
+# sleep 10;
}
}
=head2 unfilelock
unfilelock()
+ unfilelock($locks);
Unlocks the file most recently locked.
=cut
sub unfilelock {
+ my ($locks) = @_;
if (@filelocks == 0) {
- warn "unfilelock called with no active filelocks!\n";
+ carp "unfilelock called with no active filelocks!\n";
return;
}
+ if (defined $locks and ref($locks) ne 'HASH') {
+ croak "hash not passsed to unfilelock";
+ }
+ if (defined $locks and exists $locks->{lockorder} and
+ @{$locks->{lockorder}} and
+ exists $locks->{locks}{$locks->{lockorder}[-1]}) {
+ my $lockfile = pop @{$locks->{lockorder}};
+ $locks->{locks}{$lockfile}--;
+ if ($locks->{locks}{$lockfile} > 0) {
+ return
+ }
+ delete $locks->{locks}{$lockfile};
+ }
my %fl = %{pop(@filelocks)};
flock($fl{fh},LOCK_UN)
or warn "Unable to unlock lockfile $fl{file}: $!";
unlink $pidfile or
die "Unable to unlink stale pidfile $pidfile $!";
}
- my $pidfh = IO::File->new($pidfile,'w') or
+ my $pidfh = IO::File->new($pidfile,O_CREAT|O_EXCL|O_WRONLY) or
die "Unable to open $pidfile for writing: $!";
print {$pidfh} $$ or die "Unable to write to $pidfile $!";
close $pidfh or die "Unable to close $pidfile $!";
return $error;
}
+=head2 hash_slice
+
+ hash_slice(%hash,qw(key1 key2 key3))
+
+For each key, returns matching values and keys of the hash if they exist
+
+=cut
+
+
+# NB: We use prototypes here SPECIFICALLY so that we can be passed a
+# hash without uselessly making a reference to first. DO NOT USE
+# PROTOTYPES USELESSLY ELSEWHERE.
+sub hash_slice(\%@) {
+ my ($hashref,@keys) = @_;
+ return map {exists $hashref->{$_}?($_,$hashref->{$_}):()} @keys;
+}
1;
# untaint $ENV{DEBBUGS_CONFIG_FILE} if it's owned by us
# This enables us to test things that are -T.
if (exists $ENV{DEBBUGS_CONFIG_FILE}) {
- if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] = $<) {
+ if (${[stat($ENV{DEBBUGS_CONFIG_FILE})]}[4] == $<) {
$ENV{DEBBUGS_CONFIG_FILE} =~ /(.+)/;
$ENV{DEBBUGS_CONFIG_FILE} = $1;
}
sub read_config{
my ($conf_file) = @_;
if (not -e $conf_file) {
- print STDERR "configuration file '$conf_file' doesn't exist; skipping it";
+ print STDERR "configuration file '$conf_file' doesn't exist; skipping it\n" if $DEBUG;
return;
}
# first, figure out what type of file we're reading in.
$DEBUG = 0 unless defined $DEBUG;
@EXPORT = ();
- %EXPORT_TAGS = (reopen => [qw(reopen)],
+ %EXPORT_TAGS = (done => [qw(set_done)],
submitter => [qw(set_submitter)],
severity => [qw(set_severity)],
affects => [qw(affects)],
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),
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 splitpackages split_status_fields get_bug_status);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
use Debbugs::CGI qw(html_escape);
-use Debbugs::Log qw(:misc);
+use Debbugs::Log qw(:misc :write);
use Debbugs::Recipients qw(:add);
use Debbugs::Packages qw(:versions :mapping);
+use Data::Dumper qw();
use Params::Validate qw(validate_with :types);
use File::Path qw(mkpath);
+use File::Copy qw(copy);
use IO::File;
use Debbugs::Text qw(:templates);
use POSIX qw(strftime);
use Storable qw(dclone nfreeze);
-use List::Util qw(first);
+use List::Util qw(first max);
use Carp;
request_replyto => {type => SCALAR,
optional => 1,
},
+ locks => {type => HASHREF,
+ optional => 1,
+ },
);
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.
#
my $old_data = dclone($data);
# remove blockers and/or add new ones as appropriate
if ($data->{blockedby} eq '') {
- print {$transcript} "Was not blocked by any bugs.\n";
+ print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
+ } else {
+ print {$transcript} "$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} "Was blocked by: $data->{blockedby}\n";
+ 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;
my %mungable_blocks;
$mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
$mungable_blocks{add} = \%added_blockers if keys %added_blockers;
+ my $new_locks = 0;
for my $add_remove (keys %mungable_blocks) {
my @munge_blockers;
my %munge_blockers;
my $block_locks = 0;
for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
next if $munge_blockers{$blocker};
- my ($new_locks, @blocking_data) =
- lock_read_all_merged_bugs($blocker,
- ($param{archived}?'archive':()));
+ my ($temp_locks, @blocking_data) =
+ lock_read_all_merged_bugs(bug => $blocker,
+ ($param{archived}?(location => 'archive'):()),
+ exists $param{locks}?(locks => $param{locks}):(),
+ );
+ $locks+= $temp_locks;
+ $new_locks+=$temp_locks;
if (not @blocking_data) {
- unfilelock() for $new_locks;
+ for (1..$new_locks) {
+ unfilelock(exists $param{locks}?$param{locks}:());
+ $locks--;
+ }
die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
}
for (map {$_->{bug_num}} @blocking_data) {
transcript => $transcript,
);
- unfilelock() for $new_locks;
+ for (1..$new_locks) {
+ unfilelock(exists $param{locks}?$param{locks}:());
+ $locks--;
+ }
}
}
__end_control(%info);
}
Sets the severity of a bug. If severity is not passed, is undefined,
-or has zero length, sets the severity to the defafult severity.
+or has zero length, sets the severity to the default severity.
=cut
for my $data (@data) {
if (not defined $data->{severity}) {
$data->{severity} = $param{severity};
- $action = "Severity set to '$param{severity}'\n";
+ $action = "Severity set to '$param{severity}'";
}
else {
if ($data->{severity} eq '') {
print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
next;
}
- $action = "Severity set to '$param{severity}' from '$data->{severity}'\n";
+ $action = "Severity set to '$param{severity}' from '$data->{severity}'";
$data->{severity} = $param{severity};
}
append_action_to_log(bug => $data->{bug_num},
}
-=head2 reopen
+=head2 set_done
eval {
- set_foo(bug => $ref,
- transcript => $transcript,
- ($dl > 0 ? (debug => $transcript):()),
- requester => $header{from},
- request_addr => $controlrequestaddr,
- message => \@log,
- affected_packages => \%affected_packages,
- recipients => \%recipients,
- summary => undef,
- );
+ set_done(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ );
};
if ($@) {
$errors++;
=cut
-sub reopen {
+sub set_done {
my %param = validate_with(params => \@_,
spec => {bug => {type => SCALAR,
regex => qr/^\d+$/,
},
- # specific options here
- submitter => {type => SCALAR|UNDEF,
- default => undef,
+ reopen => {type => BOOLEAN,
+ default => 0,
},
+ submitter => {type => SCALAR,
+ optional => 1,
+ },
+ clear_fixed => {type => BOOLEAN,
+ default => 1,
+ },
+ notify_submitter => {type => BOOLEAN,
+ default => 1,
+ },
+ original_report => {type => SCALARREF,
+ optional => 1,
+ },
+ done => {type => SCALAR|UNDEF,
+ optional => 1,
+ },
%common_options,
%append_action_options,
},
);
- $param{submitter} = undef if defined $param{submitter} and
- not length $param{submitter};
-
- if (defined $param{submitter} and
+ if (exists $param{submitter} and
not Mail::RFC822::Address::valid($param{submitter})) {
- die "New submitter address $param{submitter} is not a valid e-mail address";
+ die "New submitter address '$param{submitter}' is not a valid e-mail address";
+ }
+ if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
+ $param{done} = $param{requester};
+ }
+ if (exists $param{done} and
+ (not defined $param{done} or
+ not length $param{done})) {
+ delete $param{done};
+ $param{reopen} = 1;
}
my %info =
__begin_control(%param,
- command => 'reopen'
+ command => $param{reopen}?'reopen':'done',
);
my ($debug,$transcript) =
@info{qw(debug transcript)};
my @bugs = @{$info{bugs}};
my $action ='';
- my $warn_fixed = 1; # avoid warning multiple times if there are
- # fixed versions
- my @change_submitter = ();
- my @bugs_to_reopen = ();
- for my $data (@data) {
- if (not exists $data->{done} or
- not defined $data->{done} or
- not length $data->{done}) {
- print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
- __end_control(%info);
- return;
+ if ($param{reopen}) {
+ # avoid warning multiple times if there are fixed versions
+ my $warn_fixed = 1;
+ for my $data (@data) {
+ if (not exists $data->{done} or
+ not defined $data->{done} or
+ not length $data->{done}) {
+ print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
+ __end_control(%info);
+ return;
+ }
+ if (@{$data->{fixed_versions}} and $warn_fixed) {
+ print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
+ print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
+ $warn_fixed = 0;
+ }
+ }
+ $action = "Bug reopened";
+ for my $data (@data) {
+ my $old_data = dclone($data);
+ $data->{done} = '';
+ append_action_to_log(bug => $data->{bug_num},
+ command => 'done',
+ new_data => $data,
+ old_data => $old_data,
+ get_lock => 0,
+ __return_append_to_log_options(
+ %param,
+ action => $action,
+ ),
+ )
+ if not exists $param{append_log} or $param{append_log};
+ writebug($data->{bug_num},$data);
}
- if (@{$data->{fixed_versions}} and $warn_fixed) {
- print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
- print {$transcript} "you may need to use 'found' to remove fixed versions.\n";
- $warn_fixed = 0;
+ print {$transcript} "$action\n";
+ __end_control(%info);
+ if (exists $param{submitter}) {
+ set_submitter(bug => $param{bug},
+ submitter => $param{submitter},
+ hash_slice(%param,
+ keys %common_options,
+ keys %append_action_options)
+ );
}
- if (defined $param{submitter} and length $param{submitter}
- and $data->{originator} ne $param{submitter}) {
- push @change_submitter,$data->{bug_num};
+ # clear the fixed revisions
+ if ($param{clear_fixed}) {
+ set_fixed(fixed => [],
+ bug => $param{bug},
+ reopen => 0,
+ hash_slice(%param,
+ keys %common_options,
+ keys %append_action_options),
+ );
}
}
- __end_control(%info);
- my @params_for_subcalls =
- map {exists $param{$_}?($_,$param{$_}):()}
- (keys %common_options,
- keys %append_action_options,
- );
+ else {
+ my %submitter_notified;
+ my $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;
+ }
- for my $bug (@change_submitter) {
- set_submitter(bug=>$bug,
- submitter => $param{submitter},
- @params_for_subcalls,
+ $action = "Marked $config{bug} as done";
+
+ # set done to the requester
+ $data->{done} = exists $param{done}?$param{done}:$param{requester};
+ append_action_to_log(bug => $data->{bug_num},
+ command => 'done',
+ new_data => $data,
+ old_data => $old_data,
+ get_lock => 0,
+ __return_append_to_log_options(
+ %param,
+ action => $action,
+ ),
+ )
+ if not exists $param{append_log} or $param{append_log};
+ writebug($data->{bug_num},$data);
+ print {$transcript} "$action\n";
+ # get the original report
+ if ($param{notify_submitter}) {
+ my $submitter_message;
+ if(not exists $submitter_notified{$data->{originator}}) {
+ $submitter_message =
+ create_mime_message([default_headers(queue_file => $param{request_nn},
+ data => $data,
+ msgid => $param{request_msgid},
+ msgtype => 'notifdone',
+ pr_msg => 'they-closed',
+ headers =>
+ [To => $data->{submitter},
+ Subject => "$config{ubug}#$data->{bug_num} ".
+ "closed by $param{requester} ($param{request_subject})",
+ ],
+ )
+ ],
+ __message_body_template('mail/process_your_bug_done',
+ {data => $data,
+ replyto => (exists $param{request_replyto} ?
+ $param{request_replyto} :
+ $param{requester} || 'Unknown'),
+ markedby => $param{requester},
+ subject => $param{request_subject},
+ messageid => $param{request_msgid},
+ config => \%config,
+ }),
+ [join('',make_list($param{message})),$orig_report]
+ );
+ send_mail_message(message => $submitter_message,
+ recipients => $old_data->{submitter},
+ );
+ $submitter_notified{$data->{originator}} = $submitter_message;
+ }
+ else {
+ $submitter_message = $submitter_notified{$data->{originator}};
+ }
+ append_action_to_log(bug => $data->{bug_num},
+ action => "Notification sent",
+ requester => '',
+ request_addr => $data->{originator},
+ desc => "$config{bug} acknowledged by developer.",
+ recips => [$data->{originator}],
+ message => $submitter_message,
+ get_lock => 0,
+ );
+ }
+ }
+ __end_control(%info);
+ if (exists $param{fixed}) {
+ set_fixed(fixed => $param{fixed},
+ bug => $param{bug},
+ reopen => 0,
+ hash_slice(%param,
+ keys %common_options,
+ keys %append_action_options
+ ),
);
+ }
}
- set_fixed(fixed => [],
- bug => $param{bug},
- reopen => 1,
- );
}
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'
for my $data (@data) {
my $old_data = dclone($data);
print {$debug} "Going to change bug forwarded\n";
- if (((not defined $param{forwarded} or not length $param{forwarded}) and
- (not defined $data->{forwarded} or not length $data->{forwarded})) or
- $param{forwarded} eq $data->{forwarded}) {
+ 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;
push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
# push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
- $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed;
+ $action = ucfirst(join ('; ',@changed)) if @changed;
if ($reopened) {
$action .= " and reopened"
}
push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
- $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed;
+ $action = ucfirst(join ('; ',@changed)) if @changed;
if ($reopened) {
$action .= " and reopened"
}
}
+=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',
+ allowed => 1,
+ },
+ found_versions => {func => \&set_found,
+ key => 'found',
+ 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
regex => qr/^\d+$/,
},
# specific options here
- packages => {type => SCALAR|ARRAYREF,
- default => [],
- },
+ package => {type => SCALAR|ARRAYREF|UNDEF,
+ default => [],
+ },
add => {type => BOOLEAN,
default => 0,
},
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'
@packages{@packages} = (1) x @packages;
if ($param{add}) {
my @added = ();
- for my $package (make_list($param{packages})) {
+ for my $package (make_list($param{package})) {
next unless defined $package and length $package;
if (not $packages{$package}) {
$packages{$package} = 1;
}
elsif ($param{remove}) {
my @removed = ();
- for my $package (make_list($param{packages})) {
+ for my $package (make_list($param{package})) {
if ($packages{$package}) {
next unless defined $package and length $package;
delete $packages{$package};
my %added_packages = ();
my %removed_packages = %packages;
%packages = ();
- for my $package (make_list($param{packages})) {
+ for my $package (make_list($param{package})) {
next unless defined $package and length $package;
$packages{$package} = 1;
delete $removed_packages{$package};
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);
If summary is 0, sets the summary to the first paragraph contained in
the message passed.
-If summary is numeric, sets the summary to the message specified.
+If summary is a positive integer, sets the summary to the message specified.
+Otherwise, sets summary to the value passed.
=cut
%append_action_options,
},
);
- croak "summary must be numeric or undef" if
- defined $param{summary} and not $param{summary} =~ /^\d+$/;
+# croak "summary must be numeric or undef" if
+# defined $param{summary} and not $param{summary} =~ /^\d+/;
my %info =
__begin_control(%param,
command => 'summary'
print {$debug} "Removing summary fields\n";
$action = 'Removed summary';
}
- else {
+ elsif ($param{summary} =~ /^\d+$/) {
my $log = [];
my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
if ($param{summary} == 0) {
# 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
+=head2 clone_bug
+
+ eval {
+ clone_bug(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to clone bug $ref bar: $@";
+ }
+
+Clones the given bug.
+
+We currently don't support cloning merged bugs, but this could be
+handled by internally unmerging, cloning, then remerging the bugs.
+
+=cut
+
+sub clone_bug {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ new_bugs => {type => ARRAYREF,
+ },
+ new_clones => {type => HASHREF,
+ default => {},
+ },
+ %common_options,
+ %append_action_options,
+ },
+ );
+ my %info =
+ __begin_control(%param,
+ command => 'clone'
+ );
+ my ($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),
+ );
+ }
+ }
+}
+
+
=head1 OWNER FUNCTIONS
print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
}
unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
- print {$transcript} "deleted $bug (from $param{bug})\n";
+ print {$debug} "deleted $bug (from $param{bug})\n";
}
bughook_archive(@bugs);
__end_control(%info);
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
die "Unable to find .log for $param{bug}"
if not defined $log_location;
if ($param{get_lock}) {
- filelock("lock/$param{bug}");
+ filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
+ $locks++;
}
- my $log = IO::File->new(">>$log_location") or
- die "Unable to open $log_location for appending: $!";
+ my @records;
+ my $logfh = IO::File->new(">>$log_location") or
+ die "Unable to open $log_location for appending: $!";
# determine difference between old and new
my $data_diff = '';
if (exists $param{old_data} and exists $param{new_data}) {
ref($old_data->{$key}) and
ref($new_data->{$key}) eq ref($old_data->{$key})) {
local $Storable::canonical = 1;
- # print STDERR Dumper($new_data,$old_data,$key);
if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
delete $new_data->{$key};
delete $old_data->{$key};
$data_diff .= html_escape(Data::Dumper->Dump([\%od],[qw(old_data)]));
$data_diff .= "-->\n";
}
- my $msg = join('',"\6\n",
+ my $msg = join('',
(exists $param{command} ?
"<!-- command:".html_escape($param{command})." -->\n":""
),
else {
$msg .= ".\n";
}
- $msg .= "\3\n";
+ push @records, {type => 'html',
+ text => $msg,
+ };
+ $msg = '';
if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
- $msg .= "\7\n".join('',escape_log(make_list($param{message})))."\n\3\n"
- or die "Unable to append to $log_location: $!";
+ push @records, {type => exists $param{recips}?'recips':'incoming-recv',
+ exists $param{recips}?(recips => [make_list($param{recips})]):(),
+ text => join('',make_list($param{message})),
+ };
}
- print {$log} $msg or die "Unable to append to $log_location: $!";
- close $log or die "Unable to close $log_location: $!";
+ write_log_records(logfh=>$logfh,
+ records => \@records,
+ );
+ close $logfh or die "Unable to close $log_location: $!";
if ($param{get_lock}) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
+ $locks--;
}
$action = "unknown action";
}
return (action => $action,
- (map {exists $append_action_options{$_}?($_,$param{$_}):()}
- keys %param),
+ hash_slice(%param,keys %append_action_options),
);
}
=cut
-our $locks = 0;
+our $lockhash;
sub __begin_control {
my %param = validate_with(params => \@_,
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($param{bug},
- ($param{archived}?'archive':()));
+ lock_read_all_merged_bugs(bug => $param{bug},
+ $param{archived}?(location => 'archive'):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
$locks += $new_locks;
if (not @data) {
die "Unable to read any bugs successfully.";
debug => $debug,
transcript => $transcript,
param => \%param,
+ exists $param{locks}?(locks => $param{locks}):(),
);
}
if (exists $info{new_locks} and $info{new_locks} > 0) {
print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
for (1..$info{new_locks}) {
- unfilelock();
+ unfilelock(exists $info{locks}?$info{locks}:());
+ $locks--;
}
}
$SIG{__DIE__} = $info{old_die};
- if (exists $info{param}{bugs_affected}) {
- @{$info{param}{bugs_affected}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
+ if (exists $info{param}{affected_bugs}) {
+ @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
}
add_recipients(recipients => $info{param}{recipients},
(exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
=cut
sub sig_die{
- #if ($^S) { # in eval
+ if ($^S) { # in eval
if ($locks) {
- for (1..$locks) { unfilelock(); }
+ for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
$locks = 0;
}
- #}
+ }
}
);
}
+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;
use Carp;
-use Debbugs::Common qw(getbuglocation getbugcomponent);
+use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
use Params::Validate qw(:types validate_with);
=head1 NAME
=cut
-sub write_log_records (*@)
+sub write_log_records
{
- my $logfh = shift;
- my @records = @_;
+ my %param = validate_with(params => \@_,
+ spec => {bug_num => {type => SCALAR,
+ optional => 1,
+ },
+ logfh => {type => HANDLE,
+ optional => 1,
+ },
+ log_name => {type => SCALAR,
+ optional => 1,
+ },
+ records => {type => HASHREF|ARRAYREF,
+ },
+ },
+ );
+ if (grep({exists $param{$_} and defined $param{$_}} qw(bug_num logfh log_name)) ne 1) {
+ croak "Exactly one of bug_num, logfh, or log_name must be passed and must be defined";
+ }
+ my $logfh;
+ if (exists $param{logfh}) {
+ $logfh = $param{logfh}
+ }
+ elsif (exists $param{log_name}) {
+ $logfh = IO::File->new(">>$param{log_name}") or
+ die "Unable to open bug log $param{log_name} for writing: $!";
+ }
+ elsif (exists $param{bug_num}) {
+ my $location = getbuglocation($param{bug_num},'log');
+ my $bug_log = getbugcomponent($param{bug_num},'log',$location);
+ $logfh = IO::File->new($bug_log, 'r') or
+ die "Unable to open bug log $bug_log for reading: $!";
+ }
+ my @records = make_list($param{records});
for my $record (@records) {
my $type = $record->{type};
+ croak "record type '$type' with no text field" unless defined $record->{text};
my ($text) = escape_log($record->{text});
- die "type '$type' with no text field" unless defined $text;
if ($type eq 'autocheck') {
- print $logfh "\01\n$text\03\n";
+ print {$logfh} "\01\n$text\03\n" or
+ die "Unable to write to logfile: $!";
} elsif ($type eq 'recips') {
- print $logfh "\02\n";
+ print {$logfh} "\02\n";
my $recips = $record->{recips};
if (defined $recips) {
- die "recips not undef or array"
+ croak "recips not undef or array"
unless ref($recips) eq 'ARRAY';
- print $logfh join("\04", @$recips) . "\n";
+ print {$logfh} join("\04", @$recips) . "\n" or
+ die "Unable to write to logfile: $!";
} else {
- print $logfh "-t\n";
+ print {$logfh} "-t\n" or
+ die "Unable to write to logfile: $!";
}
#$text =~ s/^([\01-\07\030])/\030$1/gm;
- print $logfh "\05\n$text\03\n";
+ print {$logfh} "\05\n$text\03\n" or
+ die "Unable to write to logfile: $!";
} elsif ($type eq 'html') {
- print $logfh "\06\n$text\03\n";
+ print {$logfh} "\06\n$text\03\n" or
+ die "Unable to write to logfile: $!";
} elsif ($type eq 'incoming-recv') {
#$text =~ s/^([\01-\07\030])/\030$1/gm;
- print $logfh "\07\n$text\03\n";
+ print {$logfh} "\07\n$text\03\n" or
+ die "Unable to write to logfile: $!";
} else {
- die "unknown type '$type'";
+ croak "unknown record type type '$type'";
}
}
use IPC::Open3;
use POSIX qw(:sys_wait_h strftime);
-use Time::HiRes qw(usleep);
+use Time::HiRes qw(usleep gettimeofday);
use Mail::Address ();
use Debbugs::MIME qw(encode_rfc1522);
use Debbugs::Config qw(:config);
# calculate our headers
my $bug_num = exists $param{data} ? $param{data}{bug_num} : 'x';
- my $nn = $param{queue_file};
+ my $nn = exists $param{queue_file} ? $param{queue_file} : join('',gettimeofday());
# handle the user giving the actual queue filename instead of nn
$nn =~ s/^[a-zA-Z]([a-zA-Z])/$1/;
$nn = lc($nn);
($header,$default_header{$header});
}
else {
- push @other_headers,($header,$header_order{lc($header)});
+ push @other_headers,($header,$default_header{$header});
}
}
my @headers;
actions_taken => {type => HASHREF,
default => {},
},
+ unknown_packages => {type => HASHREF,
+ default => {},
+ },
},
);
for my $data (@{$param{data}}) {
add_recipients(data => $data,
map {exists $param{$_}?($_,$param{$_}):()}
- qw(recipients debug transcript actions_taken)
+ qw(recipients debug transcript actions_taken unknown_packages)
);
}
return;
}
else {
print {$param{debug}} "maintainer none >$p<\n";
- print {$param{transcript}} "Warning: Unknown package '$p'\n";
+ if (not exists $param{unknown_packages}{$p}) {
+ print {$param{transcript}} "Warning: Unknown package '$p'\n";
+ $param{unknown_packages}{$p} = 1;
+ }
print {$param{debug}} "MR|unknown-package|$p|$ref|\n";
_add_address(recipients => $param{recipients},
address => $config{unknown_maintainer_email},
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
+use File::Copy qw(copy);
use Storable qw(dclone);
use List::Util qw(min max);
qw(lock_read_all_merged_bugs),
],
write => [qw(writebug makestatus unlockwritebug)],
+ new => [qw(new_bug)],
versions => [qw(addfoundversions addfixedversions),
qw(removefoundversions removefixedversions)
],
fields => [qw(%fields)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(status read write versions hook fields));
+ Exporter::export_ok_tags(keys %EXPORT_TAGS);
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
something modifying it while the bug has been read. You B<must> call
C<unfilelock();> if something not undef is returned from read_bug.
+=item locks -- hashref of already obtained locks; incremented as new
+locks are needed, and decremented as locks are released on particular
+files.
+
=back
One of C<bug> or C<summary> must be passed. This function will return
lock => {type => BOOLEAN,
optional => 1,
},
+ locks => {type => HASHREF,
+ optional => 1,
+ },
},
);
die "One of bug or summary must be passed to read_bug"
($location) = $status =~ m/(db-h|db|archive)/;
}
if ($param{lock}) {
- filelock("$config{spool_dir}/lock/$param{bug}");
+ filelock("$config{spool_dir}/lock/$param{bug}",exists $param{locks}?$param{locks}:());
}
my $status_fh = IO::File->new($status, 'r');
if (not defined $status_fh) {
warn "Unable to open $status for reading: $!";
if ($param{lock}) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
return undef;
}
if ($version > 3) {
warn "Unsupported status version '$version'";
if ($param{lock}) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
return undef;
}
=cut
sub lock_read_all_merged_bugs {
- my ($bug_num,$location) = @_;
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ location => {type => SCALAR,
+ optional => 1,
+ },
+ locks => {type => HASHREF,
+ optional => 1,
+ },
+ },
+ );
my $locks = 0;
- my @data = (lockreadbug(@_));
+ my @data = read_bug(bug => $param{bug},
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not @data or not defined $data[0]) {
return ($locks,());
}
if (not length $data[0]->{mergedwith}) {
return ($locks,@data);
}
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
$locks--;
- filelock("$config{spool_dir}/lock/merge");
+ filelock("$config{spool_dir}/lock/merge",exists $param{locks}?$param{locks}:());
$locks++;
- @data = (lockreadbug(@_));
+ @data = read_bug(bug => $param{bug},
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not @data or not defined $data[0]) {
- unfilelock(); #for merge lock above
+ unfilelock(exists $param{locks}?$param{locks}:()); #for merge lock above
$locks--;
return ($locks,());
}
$locks++;
my @bugs = split / /, $data[0]->{mergedwith};
+ push @bugs, $param{bug};
for my $bug (@bugs) {
my $newdata = undef;
- if ($bug ne $bug_num) {
- $newdata = lockreadbug($bug,$location);
+ if ($bug != $param{bug}) {
+ $newdata =
+ read_bug(bug => $bug,
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not defined $newdata) {
for (1..$locks) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
$locks = 0;
- warn "Unable to read bug: $bug while handling merged bug: $bug_num";
+ warn "Unable to read bug: $bug while handling merged bug: $param{bug}";
return ($locks,());
}
$locks++;
push @data,$newdata;
- }
- # perform a sanity check to make sure that the merged bugs are
- # all merged with eachother
- my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } (@bugs,$bug_num));
- if ($newdata->{mergedwith} ne $expectmerge) {
- for (1..$locks) {
- unfilelock();
+ # perform a sanity check to make sure that the merged bugs
+ # are all merged with eachother
+ my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } @bugs);
+ if ($newdata->{mergedwith} ne $expectmerge) {
+ for (1..$locks) {
+ unfilelock(exists $param{locks}?$param{locks}:());
+ }
+ die "Bug $param{bug} differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")";
}
- die "Bug $bug_num differs from bug $bug: ($newdata->{bug_num}: $newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
}
}
return ($locks,@data);
}
+=head2 new_bug
+
+ my $new_bug_num = new_bug(copy => $data->{bug_num});
+
+Creates a new bug and returns the new bug number upon success.
+
+Dies upon failures.
+
+=cut
+
+sub new_bug {
+ my %param =
+ validate_with(params => \@_,
+ spec => {copy => {type => SCALAR,
+ regex => qr/^\d+/,
+ optional => 1,
+ },
+ },
+ );
+ filelock("nextnumber.lock");
+ my $nn_fh = IO::File->new("nextnumber",'r') or
+ die "Unable to open nextnuber for reading: $!";
+ local $\;
+ my $nn = <$nn_fh>;
+ ($nn) = $nn =~ m/^(\d+)\n$/ or die "Bad format of nextnumber; is not exactly ".'^\d+\n$';
+ close $nn_fh;
+ overwritefile("nextnumber",
+ ($nn+1)."\n");
+ unfilelock();
+ my $nn_hash = get_hashname($nn);
+ use IO::File;
+ my $t_fh = IO::File->new("/home/don/temp.txt",'a') or die "Unable to open ~don/temp.txt for writing: $!";
+ use Data::Dumper;
+ print {$t_fh} Dumper({%param,nn => $nn, nn_hash => $nn_hash, nextnumber => qx(cat nextnumber)});
+ close $t_fh;
+ if ($param{copy}) {
+ my $c_hash = get_hashname($param{copy});
+ for my $file (qw(log status summary report)) {
+ copy("db-h/$c_hash/$param{copy}.$file",
+ "db-h/$nn_hash/${nn}.$file")
+ }
+ }
+ else {
+ for my $file (qw(log status summary report)) {
+ overwritefile("db-h/$nn_hash/${nn}.$file",
+ "");
+ }
+ }
+
+ # this probably needs to be munged to do something more elegant
+# &bughook('new', $clone, $data);
+
+ return($nn);
+}
+
+
my @v1fieldorder = qw(originator date subject msgid package
keywords done forwarded mergedwith severity);
sub unlockwritebug {
writebug(@_);
- &unfilelock;
+ unfilelock();
}
=head1 VERSIONS
}
# Check to make sure that the bug has none of the unremovable tags set
if (@{$config{removal_unremovable_tags}}) {
- for my $tag (split ' ', ($status->{tags}||'')) {
+ for my $tag (split ' ', ($status->{keywords}||'')) {
if (grep {$tag eq $_} @{$config{removal_unremovable_tags}}) {
print STDERR "Cannot archive $param{bug} because it has an unremovable tag '$tag'\n" if $DEBUG;
return $cannot_archive;
@dist_tags{@{$config{removal_distribution_tags}}} =
(1) x @{$config{removal_distribution_tags}};
my %dists;
- for my $tag (split ' ', ($status->{tags}||'')) {
+ for my $tag (split ' ', ($status->{keywords}||'')) {
next unless exists $config{distribution_aliases}{$tag};
next unless $dist_tags{$config{distribution_aliases}{$tag}};
$dists{$config{distribution_aliases}{$tag}} = 1;
(1) x @{$config{affects_distribution_tags}};
my $some_distributions_disallowed = 0;
my %allowed_distributions;
- for my $tag (split ' ', ($status{tags}||'')) {
+ for my $tag (split ' ', ($status{keywords}||'')) {
if (exists $config{distribution_aliases}{$tag} and
exists $affects_distribution_tags{$config{distribution_aliases}{$tag}}) {
$some_distributions_disallowed = 1;
sub bughook_archive {
my @refs = @_;
- &filelock("$config{spool_dir}/debbugs.trace.lock");
- &appendfile("debbugs.trace","archive ".join(',',@refs)."\n");
+ filelock("$config{spool_dir}/debbugs.trace.lock");
+ appendfile("$config{spool_dir}/debbugs.trace","archive ".join(',',@refs)."\n");
my %bugs = update_realtime("$config{spool_dir}/index.db.realtime",
map{($_,'REMOVE')} @refs);
update_realtime("$config{spool_dir}/index.archive.realtime",
%bugs);
- &unfilelock;
+ unfilelock();
}
sub bughook {
my ( $type, %bugs_temp ) = @_;
- &filelock("$config{spool_dir}/debbugs.trace.lock");
+ filelock("$config{spool_dir}/debbugs.trace.lock");
my %bugs;
for my $bug (keys %bugs_temp) {
my $data = $bugs_temp{$bug};
- &appendfile("debbugs.trace","$type $bug\n",makestatus($data, 1));
+ appendfile("$config{spool_dir}/debbugs.trace","$type $bug\n",makestatus($data, 1));
my $whendone = "open";
my $severity = $config{default_severity};
}
update_realtime("$config{spool_dir}/index.db.realtime", %bugs);
- &unfilelock;
+ unfilelock();
}
qw(rv2gv refgen srefgen ref),
qw(caller require entereval),
qw(gmtime time sprintf prtf),
+ qw(sort),
);
$safe->share('*STDERR');
$safe->share('%config');
add_bug_to_estraier [options] < list_of_bugs_to_add
Options:
+ --url, -u url to estraier node
+ --user, -U user to log into the estraier node
+ --pass, -P password for the estraier node
+ --spool, -s spool location
+ --conf, -c addbug configuration file
+ --cron add all bugs to estraier
+ --timestamp bug timestamp file
--debug, -d debugging level (Default 0)
--help, -h display this help
--man, -m display manual
my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
if (not defined $pid or $pid == 0) {
print STDERR "Unable to open pidfile or daemon not running: $!\n";
- print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
+ print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
print STDERR "Hint: try the --daemon option first\n";
exit 1;
}
-#!/usr/bin/perl -wT
+#!/usr/bin/perl
use warnings;
use strict;
+# Sanitize environent for taint
+BEGIN{
+ delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+}
+
use POSIX qw(strftime);
use MIME::Parser;
use MIME::Decoder;
use warnings;
use strict;
+# Sanitize environent for taint
+BEGIN{
+ delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+}
+
use POSIX qw(strftime nice);
use Debbugs::Config qw(:globals :text :config);
+debbugs (2.4.2~exp2) experimental; urgency=low
+
+ * Hack around elinks css bug (closes: #593804)
+
+ -- Don Armstrong <don@debian.org> Wed, 25 Aug 2010 01:57:38 -0700
+
debbugs (2.4.2~exp1) experimental; urgency=low
* Allow (almost) exactly what RFC2822 allows in comments (closes:
Wirzenius
* Don't RFC1522 escape ", ( and ). (Closes: #588859). Thanks to Glenn
Morris
+ * Various changes to make debbugs-local work better (Closes: #585796)
+ - Add libnet-server-fork-perl to Depends for debbugs-local
+ - Sanitize env in -T code
- -- Don Armstrong <don@debian.org> Wed, 26 Aug 2009 21:32:53 -0700
+ -- Don Armstrong <don@debian.org> Thu, 05 Aug 2010 21:54:12 -0700
debbugs (2.4.2~exp0) experimental; urgency=low
Package: debbugs-local
Architecture: all
Depends: libdebbugs-perl, debbugs-web, libconfig-simple-perl,
- libuser-perl, rsync, libhttp-server-simple-perl
+ libuser-perl, rsync, libhttp-server-simple-perl, libnet-server-perl
Description: run and maintains a local mirror of the Debian BTS
Debian has a bug tracking system which files details of bugs reported
by users and developers. Each bug is given a number, and is kept on
elsif (/^$/) {
# see MLDBM(3pm)/BUGS
my $tmp = $db{$p};
- $tmp->{$dist}{$arch} = $v;
+ # we allow multiple versions in an architecture now; this
+ # should really only happen in the case of source, however.
+ push @{$tmp->{$dist}{$arch}}, $v;
$db{$p} = $tmp;
$tmp = $db2{$p};
$tmp->{$dist}{$arch}{$v} = $time if not exists
--- /dev/null
+#! /usr/bin/perl -w
+use strict;
+use MLDBM qw(DB_File Storable);
+use Fcntl;
+
+$MLDBM::DumpMeth=q(portable);
+
+my (%srcbin, %binsrc);
+tie %srcbin, 'MLDBM', '/org/bugs.debian.org/versions/indices/srcbin_rebuild.idx',
+ O_CREAT|O_RDWR, 0644
+ or die "tie srcbin_rebuild.idx: $!";
+tie %binsrc, 'MLDBM', '/org/bugs.debian.org/versions/indices/binsrc_rebuild.idx',
+ O_CREAT|O_RDWR, 0644
+ or die "tie binsrc_rebuild.idx: $!";
+
+
+my %temp_srcbin;
+my %temp_binsrc;
+while (<>) {
+ my ($binname, $binver, $binarch, $srcname, $srcver) = split;
+ if (not defined $srcver) {
+ print STDERR "Something is wrong with file: $ARGV line $.: 0x".unpack(q(H*),$_)."\n";
+ next;
+ }
+
+ # see MLDBM(3pm)/BUGS
+ if (not exists $temp_srcbin{$srcname}) {
+ $temp_srcbin{$srcname} = $srcbin{$srcname} // {};
+ }
+ push_if_not_exists($temp_srcbin{$srcname}{$srcver},[$binname, $binver, $binarch]);
+ if (not exists $temp_binsrc{$binname}) {
+ $temp_binsrc{$binname} = $binsrc{$binname} // {};
+ }
+ $temp_binsrc{$binname}{$binver}{$binarch} = [$srcname, $srcver];
+}
+for my $key (keys %temp_srcbin) {
+ $srcbin{$key} = $temp_srcbin{$key};
+}
+for my $key (keys %temp_binsrc) {
+ $binsrc{$key} = $temp_binsrc{$key};
+}
+
+sub push_if_not_exists{
+ my ($array,@push_bits) = @_;
+ PUSH_CHECK: for my $push_bit (@push_bits) {
+ my $push_ok = 1;
+ my @pb = @{$push_bit};
+ ARRAY_CHECK: for my $array_bit (@{$array}) {
+ my @ab = @{$array_bit};
+ next ARRAY_CHECK unless $#ab == $#pb;
+ for my $i (0..$#ab) {
+ next ARRAY_CHECK if $ab[$i] ne $pb[$i];
+ }
+ # if we get here, then the array has matched; skip to the
+ # next thing to try to push
+ next PUSH_CHECK;
+ }
+ push @{$array},$push_bit;
+ }
+}
--- /dev/null
+## configuration options
+
+## database creation
+
+estcmd create -si -apn -xh3 \
+ -attr status string \
+ -attr subject string \
+ -attr date number \
+ -attr submitter string \
+ -attr package string \
+ -attr tags string \
+ -attr severity string \
+ bts
+
+# status subject date submitter package tags severity
\ No newline at end of file
}
body {
+ color: #000;
+ background: #fefefe;
margin: 10px;
border: 0;
padding: 0;
}
h1, h2, h3 {
+ color: #000;
+ background: #fefefe;
text-align: left;
font-family: sans-serif;
}
use Debbugs::Mail qw(send_mail_message encode_headers get_addresses);
use Debbugs::Packages qw(getpkgsrc binary_to_source);
use Debbugs::User qw(read_usertags write_usertags);
-use Debbugs::Common qw(:lock get_hashname package_maintainer);
-use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug read_bug splitpackages :versions);
+use Debbugs::Common qw(:lock get_hashname package_maintainer overwritefile);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug new_bug read_bug splitpackages :versions);
use Debbugs::CGI qw(html_escape bug_url);
-use Debbugs::Log qw(:misc);
+use Debbugs::Log qw(:misc :write);
use Debbugs::Text qw(:templates);
$source_package = $pheader{source};
}
elsif (defined $data->{package} or defined $pheader{package}) {
- my $pkg_src = getpkgsrc();
- $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
+ $source_package = binary_to_source(binary => $data->{package} // $pheader{package});
}
$source_pr_header = "X-$gProject-PR-Source: $source_package\n"
if defined $source_package and length $source_package;
push @generalcc, "$gForwardList\@$gListDomain";
$generalcc= "$gForwardList\@$gListDomain";
} else {
- $generalcc='';
+ $generalcc='';
}
} else { # Done
if (defined $data->{done} and length($data->{done}) and
$data->{package} = 'src:'.$pheader{source};
} elsif (defined $pheader{package}) {
$data->{package} = $pheader{package};
+ if ($data->{package} =~ /^src:(.+)/) {
+ $pheader{source} = $1;
+ }
} elsif (defined $config{default_package}) {
$data->{package} = $config{default_package},
}
if (defined($pheader{forwarded})) {
$data->{forwarded} = $pheader{forwarded};
}
- &filelock("nextnumber.lock");
- open(N,"nextnumber") || die "nextnumber: read: $!";
- my $nextnumber=<N>; $nextnumber =~ s/\n$// || die "nextnumber bad format";
- $ref= $nextnumber+0; $nextnumber += 1; $newref=1;
- &overwrite('nextnumber', "$nextnumber\n");
- &unfilelock;
+ $ref = new_bug();
my $hash = get_hashname($ref);
- &overwrite("db-h/$hash/$ref.log",'');
$data->{originator} = $replyto;
$data->{date} = $intdate;
$data->{subject} = $subject;
);
}
}
- &overwrite("db-h/$hash/$ref.report",
- join("\n",@msg)."\n");
+ overwritefile("db-h/$hash/$ref.report",
+ map {"$_\n"} @msg);
}
&checkmaintainers;
&appendlog;
&finish;
-sub overwrite {
- my ($f,$v) = @_;
- open(NEW,">$f.new") || die "$f.new: create: $!";
- print(NEW "$v") || die "$f.new: write: $!";
- close(NEW) || die "$f.new: close: $!";
- rename("$f.new","$f") || die "rename $f.new to $f: $!";
-}
-
sub appendlog {
my $hash = get_hashname($ref);
if (!open(AP,">>db-h/$hash/$ref.log")) {
my $hash = get_hashname($ref);
#save email to the log
- open(AP,">>db-h/$hash/$ref.log") || die "opening db-h/$hash/$ref.log (lo): $!";
- print(AP "\2\n",join("\4",@$recips),"\n\5\n",
- escape_log(stripbccs($msg)),"\n\3\n") ||
- die "writing db-h/$hash/$ref.log (lo): $!";
- close(AP) || die "closing db-h/$hash/$ref.log (lo): $!";
-
+ my $logfh = IO::File->new(">>db-h/${hash}/${ref}.log") or
+ die "opening db-h/$hash/${ref}.log: $!";
+ write_log_records(logfh => $logfh,
+ records => {text => stripbccs($msg),
+ type => 'recips',
+ recips => [@{$recips}],
+ },
+ );
if (ref($bcc)) {
shift @$recips if $recips->[0] eq '-t';
push @$recips, @$bcc;
request_nn => $nn,
request_replyto => $replyto,
message => \@log,
+ affected_bugs => \%bug_affected,
affected_packages => \%affected_packages,
recipients => \%recipients,
limit => \%limit,
}
#### "developer only" ones start here
} elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
- $ok++;
- $ref= $1;
+ $ok++;
+ $ref= $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref}=1;
- my $version= $2;
- if (&setbug) {
- print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
- if (length($data->{done}) and not defined($version)) {
- print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
- &nochangebug;
- } else {
- $action= "$gBug " .
- (defined($version) ?
- "marked as fixed in version $version" :
- "closed") .
- ", send any further explanations to $data->{originator}";
- do {
- $affected_packages{$data->{package}} = 1;
- add_recipients(data => $data,
- recipients => \%recipients,
- actions_taken => {done => 1},
- transcript => $transcript,
- ($dl > 0 ? (debug => $transcript):()),
- );
- $data->{done}= $replyto;
- my @keywords= split ' ', $data->{keywords};
- my $extramessage = '';
- if (grep $_ eq 'pending', @keywords) {
- $extramessage= "Removed pending tag.\n";
- $data->{keywords}= join ' ', grep $_ ne 'pending',
- @keywords;
- }
- addfixedversions($data, $data->{package}, $version, 'binary');
-
- my $message= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $data->{originator}
-Subject: $gBug#$ref acknowledged by developer
- ($header{'subject'})
-References: $header{'message-id'} $data->{msgid}
-In-Reply-To: $data->{msgid}
-Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
-Reply-To: $ref\@$gEmailDomain
-X-$gProject-PR-Message: they-closed-control $ref
-
-This is an automatic notification regarding your $gBug report
-#$ref: $data->{subject},
-which was filed against the $data->{package} package.
-
-It has been marked as closed by one of the developers, namely
-$replyto.
-
-You should be hearing from them with a substantive response shortly,
-in case you haven't already. If not, please contact them directly.
-
-$gMaintainer
-(administrator, $gProject $gBugs database)
-
-END
- &sendmailmessage($message,$data->{originator});
- } while (&getnextbug);
- }
- }
+ if (defined $2) {
+ eval {
+ set_fixed(@common_control_options,
+ bug => $ref,
+ fixed => $2,
+ add => 1,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to add fixed version '$2' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
+ }
+ }
+ eval {
+ set_done(@common_control_options,
+ done => 1,
+ bug => $ref,
+ reopen => 0,
+ notify_submitter => 1,
+ clear_fixed => 0,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to mark $ref as done: ".cleanup_eval_fail($@,$debug)."\n";
+ }
} elsif (m/^reassign\s+\#?(-?\d+)\s+ # bug and command
(?:(?:((?:src:|source:)?$config{package_name_re}) # new package
(?:\s+((?:$config{package_name_re}\/)?
}
@new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref}=1;
my $version= $3;
eval {
set_package(@common_control_options,
$ok++;
$ref= $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref}=1;
my $new_submitter = $2;
if (defined $new_submitter) {
if ($new_submitter eq '=') {
}
}
eval {
- reopen(@common_control_options,
- bug => $ref,
- submitter => $new_submitter,
- );
+ set_done(@common_control_options,
+ bug => $ref,
+ reopen => 1,
+ submitter => $new_submitter,
+ );
};
if ($@) {
$errors++;
elsif (m/^submitter\s+\#?(-?\d+)\s+(\!|\S.*\S)$/i) {
$ok++;
$ref= $1;
- $bug_affected{$ref}=1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
my $newsubmitter = $2 eq '!' ? $replyto : $2;
if (not Mail::RFC822::Address::valid($newsubmitter)) {
$ref= $1;
my $forward_to= $2;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
set_forwarded(@common_control_options,
bug => $ref,
$ok++;
$ref= $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
set_forwarded(@common_control_options,
bug => $ref,
$ok++;
$ref= $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref}=1;
my $newseverity= $2;
if (exists $gObsoleteSeverities{$newseverity}) {
print {$transcript} "Severity level \`$newseverity' is obsolete. " .
$ok++;
$ref = $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref}=1;
my $tags = $2;
my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
# this is an array of hashrefs which contain two elements, the
my $add_remove = defined $1 && $1 eq 'un';
my @blockers = map {exists $clonebugs{$_}?$clonebugs{$_}:$_} split /[\s,]+/, $3;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
set_blocks(@common_control_options,
bug => $ref,
$ok++;
$ref= $1; my $newtitle= $2;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
set_title(@common_control_options,
bug => $ref,
} elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
$ok++;
$ref= $1;
- $bug_affected{$ref} = 1;
- if (&setbug) {
- if (!length($data->{mergedwith})) {
- print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
- &nochangebug;
- } else {
- $mergelowstate eq 'locked' || die "$mergelowstate ?";
- $action= "Disconnected #$ref from all other report(s).";
- my @newmergelist= split(/ /,$data->{mergedwith});
- my $discref= $ref;
- @bug_affected{@newmergelist} = 1 x @newmergelist;
- do {
- $affected_packages{$data->{package}} = 1;
- add_recipients(data => $data,
- recipients => \%recipients,
- transcript => $transcript,
- ($dl > 0 ? (debug => $transcript):()),
- );
- $data->{mergedwith}= ($ref == $discref) ? ''
- : join(' ',grep($_ ne $ref,@newmergelist));
- } while (&getnextbug);
- }
+ $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
+ eval {
+ set_merged(@common_control_options,
+ bug => $ref,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to unmerge $ref: $@".cleanup_eval_fail($@,$debug)."\n";
}
} elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
$ok++;
- my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
- my @newmergelist= ();
- my %tags = ();
- my %found = ();
- my %fixed = ();
- &getmerge;
- while (defined($ref= shift(@tomerge))) {
- print {$transcript} "D| checking merge $ref\n" if $dl;
- $ref+= 0;
- if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
- $ref = $clonebugs{$ref};
- }
- next if grep($_ == $ref,@newmergelist);
- if (!&getbug) { ¬foundbug; @newmergelist=(); last }
- if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
- &foundbug;
- print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
- $mismatch= '';
- &checkmatch('package','m_package',$data->{package},@newmergelist);
- &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
- $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
- &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
- &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
- &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
- &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
- &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
- &checkmatch('summary','m_summary',$data->{summary},@newmergelist);
- &checkmatch('affects','m_affects',$data->{affects},@newmergelist);
- foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
- foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
- foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
- if (length($mismatch)) {
- print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
- $mismatch."\n";
- $errors++;
- &cancelbug; @newmergelist=(); last;
- }
- push(@newmergelist,$ref);
- push(@tomerge,split(/ /,$data->{mergedwith}));
- &cancelbug;
- }
- if (@newmergelist) {
- @newmergelist= sort { $a <=> $b } @newmergelist;
- $action= "Merged @newmergelist.";
- delete @fixed{keys %found};
- for $ref (@newmergelist) {
- &getbug || die "huh ? $gBug $ref disappeared during merge";
- $affected_packages{$data->{package}} = 1;
- add_recipients(data => $data,
- recipients => \%recipients,
- transcript => $transcript,
- ($dl > 0 ? (debug => $transcript):()),
- );
- @bug_affected{@newmergelist} = 1 x @newmergelist;
- $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
- $data->{keywords}= join(' ', keys %tags);
- $data->{found_versions}= [sort keys %found];
- $data->{fixed_versions}= [sort keys %fixed];
- &savebug;
- }
- print {$transcript} "$action\n\n";
+ my @tomerge;
+ ($ref,@tomerge) = map {exists $clonebugs{$_}?$clonebugs{$_}:$_}
+ split(/\s+#?/,$1);
+ eval {
+ set_merged(@common_control_options,
+ bug => $ref,
+ merge_with => \@tomerge,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to merge $ref: $@".cleanup_eval_fail($@,$debug)."\n";
}
- &endmerge;
} elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
$ok++;
- my @temp = split /\s+\#?/,$1;
- my $master_bug = shift @temp;
- my $master_bug_data;
- my @tomerge = sort { $a <=> $b } @temp;
- unshift @tomerge,$master_bug;
- print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
- my @newmergelist= ();
- my %tags = ();
- my %found = ();
- my %fixed = ();
- # Here we try to do the right thing.
- # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
- # If not, we discard the found and fixed.
- # Everything else we set to the values of the first bug.
- &getmerge;
- while (defined($ref= shift(@tomerge))) {
- print {$transcript} "D| checking merge $ref\n" if $dl;
- $ref+= 0;
- if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
- $ref = $clonebugs{$ref};
- }
- next if grep($_ == $ref,@newmergelist);
- if (!&getbug) { ¬foundbug; @newmergelist=(); last }
- if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
- &foundbug;
- print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
- $master_bug_data = $data if not defined $master_bug_data;
- if ($data->{package} ne $master_bug_data->{package}) {
- print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
- "$gBug $ref is not in the same package as $master_bug\n";
- $errors++;
- &cancelbug; @newmergelist=(); last;
- }
- for my $t (split /\s+/,$data->{keywords}) {
- $tags{$t} = 1;
- }
- @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
- @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
- push(@newmergelist,$ref);
- push(@tomerge,split(/ /,$data->{mergedwith}));
- &cancelbug;
- }
- if (@newmergelist) {
- @newmergelist= sort { $a <=> $b } @newmergelist;
- $action= "Forcibly Merged @newmergelist.";
- delete @fixed{keys %found};
- for $ref (@newmergelist) {
- &getbug || die "huh ? $gBug $ref disappeared during merge";
- $affected_packages{$data->{package}} = 1;
- add_recipients(data => $data,
- recipients => \%recipients,
- transcript => $transcript,
- ($dl > 0 ? (debug => $transcript):()),
- );
- @bug_affected{@newmergelist} = 1 x @newmergelist;
- $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
- $data->{keywords}= join(' ', keys %tags);
- $data->{found_versions}= [sort keys %found];
- $data->{fixed_versions}= [sort keys %fixed];
- my @field_list = qw(forwarded package severity blocks blockedby owner done affects summary);
- @{$data}{@field_list} = @{$master_bug_data}{@field_list};
- &savebug;
- }
- print {$transcript} "$action\n\n";
+ my @tomerge;
+ ($ref,@tomerge) = map {exists $clonebugs{$_}?$clonebugs{$_}:$_}
+ split(/\s+#?/,$1);
+ eval {
+ set_merged(@common_control_options,
+ bug => $ref,
+ merge_with => \@tomerge,
+ force => 1,
+ masterbug => 1,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
}
- &endmerge;
} elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
$ok++;
my $newbugsneeded = scalar(@newclonedids);
$ref = $origref;
+ if (exists $clonebugs{$ref}) {
+ $ref = $clonebugs{$ref};
+ }
$bug_affected{$ref} = 1;
- if (&setbug) {
- $affected_packages{$data->{package}} = 1;
- if (length($data->{mergedwith})) {
- print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
- $errors++;
- &nochangebug;
- } else {
- &filelock("nextnumber.lock");
- open(N,"nextnumber") || die "nextnumber: read: $!";
- my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
- my $firstref= $v+0; $v += $newbugsneeded;
- open(NN,">nextnumber"); print NN "$v\n"; close(NN);
- &unfilelock;
-
- my $lastref = $firstref + $newbugsneeded - 1;
-
- if ($newbugsneeded == 1) {
- $action= "$gBug $origref cloned as bug $firstref.";
- } else {
- $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
- }
-
- my $blocks = $data->{blocks};
- my $blockedby = $data->{blockedby};
-
- &getnextbug;
- my $ohash = get_hashname($origref);
- my $clone = $firstref;
- @bug_affected{@newclonedids} = 1 x @newclonedids;
- for my $newclonedid (@newclonedids) {
- $clonebugs{$newclonedid} = $clone;
-
- my $hash = get_hashname($clone);
- copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
- copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
- copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
- copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
- &bughook('new', $clone, $data);
-
- # Update blocking info of bugs blocked by or blocking the
- # cloned bug.
- foreach $ref (split ' ', $blocks) {
- &getbug;
- $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
- &savebug;
- }
- foreach $ref (split ' ', $blockedby) {
- &getbug;
- $data->{blocks} = manipset($data->{blocks}, $clone, 1);
- &savebug;
- }
-
- $clone++;
- }
- }
+ eval {
+ my %new_clones;
+ clone_bug(@common_control_options,
+ bug => $ref,
+ new_bugs => \@newclonedids,
+ new_clones => \%new_clones,
+ );
+ %clonebugs = (%clonebugs,
+ %new_clones);
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to clone $ref: ".cleanup_eval_fail($@,$debug)."\n";
}
} elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
$ok++;
my $add_remove = $2 || '';
my $packages = $3 || '';
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
affects(@common_control_options,
bug => $ref,
- packages => [splitpackages($3)],
+ package => [splitpackages($3)],
($add_remove eq '+'?(add => 1):()),
($add_remove eq '-'?(remove => 1):()),
);
$ref = $1;
my $summary_msg = length($2)?$2:undef;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
summary(@common_control_options,
bug => $ref,
if ($newowner eq '!') {
$newowner = $replyto;
}
- $bug_affected{$ref} = 1;
eval {
owner(@common_control_options,
bug => $ref,
$ok++;
$ref = $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
owner(@common_control_options,
bug => $ref,
$ok++;
$ref = $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
bug_unarchive(@common_control_options,
bug => $ref,
$ok++;
$ref = $1;
$ref = $clonebugs{$ref} if exists $clonebugs{$ref};
- $bug_affected{$ref} = 1;
eval {
bug_archive(@common_control_options,
bug => $ref,
my $variables = {config => \%config,
defined($ref)?(ref => $ref):(),
defined($data)?(data => $data):(),
- refs => [keys %bug_affected],
+ refs => [map {exists $clonebugs{$_}?$clonebugs{$_}:$_} keys %bug_affected],
%{$extra_var},
};
my $hole_var = {'&bugurl' =>
result => -1,
relation => 'lt',
},
- {a => 'foo-',
- b => 'foo',
+ {a => '1foo-',
+ b => '1foo',
result => 0,
relation => 'eq',
},
- {a => 'foo-',
- b => 'foo+',
+ {a => '1foo-',
+ b => '1foo+',
result => -1,
relation => 'lt',
},
--- /dev/null
+# -*- mode: cperl;-*-
+
+use Test::More tests => 29;
+
+use warnings;
+use strict;
+
+# Here, we're going to shoot messages through a set of things that can
+# happen.
+
+# First, we're going to send mesages to receive.
+# To do so, we'll first send a message to submit,
+# then send messages to the newly created bugnumber.
+
+use IO::File;
+use File::Temp qw(tempdir);
+use Cwd qw(getcwd);
+use Debbugs::MIME qw(create_mime_message);
+use File::Basename qw(dirname basename);
+# The test functions are placed here to make things easier
+use lib qw(t/lib);
+use DebbugsTest qw(:all);
+use Data::Dumper;
+
+# HTTP::Server:::Simple defines a SIG{CHLD} handler that breaks system; undef it here.
+$SIG{CHLD} = sub {};
+my %config;
+eval {
+ %config = create_debbugs_configuration(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0);
+};
+if ($@) {
+ BAIL_OUT($@);
+}
+
+my $sendmail_dir = $config{sendmail_dir};
+my $spool_dir = $config{spool_dir};
+my $config_dir = $config{config_dir};
+
+END{
+ if ($ENV{DEBUG}) {
+ diag("spool_dir: $spool_dir\n");
+ diag("config_dir: $config_dir\n");
+ diag("sendmail_dir: $sendmail_dir\n");
+ }
+}
+
+# We're going to use create mime message to create these messages, and
+# then just send them to receive.
+
+send_message(to=>'submit@bugs.something',
+ headers => [To => 'submit@bugs.something',
+ From => 'foo@bugs.something',
+ Subject => 'Submiting a bug',
+ ],
+ body => <<EOF) or fail('Unable to send message');
+Package: foo
+Severity: normal
+
+This is a silly bug
+EOF
+
+# now we check to see that we have a bug, and nextnumber has been incremented
+ok(-e "$spool_dir/db-h/01/1.log",'log file created');
+ok(-e "$spool_dir/db-h/01/1.summary",'sumary file created');
+ok(-e "$spool_dir/db-h/01/1.status",'status file created');
+ok(-e "$spool_dir/db-h/01/1.report",'report file created');
+
+# next, we check to see that (at least) the proper messages have been
+# sent out. 1) ack to submitter 2) mail to maintainer
+
+# This keeps track of the previous size of the sendmail directory
+my $SD_SIZE = 0;
+$SD_SIZE =
+ num_messages_sent($SD_SIZE,2,
+ $sendmail_dir,
+ 'submit messages appear to have been sent out properly',
+ );
+
+
+# now send a message to the bug
+
+send_message(to => '1@bugs.something',
+ headers => [To => '1@bugs.something',
+ From => 'foo@bugs.something',
+ Subject => 'Sending a message to a bug',
+ ],
+ body => <<EOF) or fail('sending message to 1@bugs.someting failed');
+Package: foo
+Severity: normal
+
+This is a silly bug
+EOF
+
+$SD_SIZE =
+ num_messages_sent($SD_SIZE,2,
+ $sendmail_dir,
+ '1@bugs.something messages appear to have been sent out properly');
+
+# just check to see that control doesn't explode
+send_message(to => 'control@bugs.something',
+ headers => [To => 'control@bugs.something',
+ From => 'foo@bugs.something',
+ Subject => 'Munging a bug',
+ ],
+ body => <<EOF) or fail 'message to control@bugs.something failed';
+severity 1 wishlist
+retitle 1 new title
+thanks
+EOF
+
+$SD_SIZE =
+ num_messages_sent($SD_SIZE,1,
+ $sendmail_dir,
+ 'control@bugs.something messages appear to have been sent out properly');
+# now we need to check to make sure the control message was processed without errors
+ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug")) == 0,
+ 'control@bugs.something message was parsed without errors');
+# now we need to check to make sure that the control message actually did anything
+# This is an eval because $ENV{DEBBUGS_CONFIG_FILE} isn't set at BEGIN{} time
+eval "use Debbugs::Status qw(read_bug writebug);";
+my $status = read_bug(bug=>1);
+ok($status->{subject} eq 'new title','bug 1 retitled');
+ok($status->{severity} eq 'wishlist','bug 1 wishlisted');
+
+# now we're going to go through and methododically test all of the control commands.
+my @control_commands =
+ (
+ clone => {command => 'clone',
+ value => '-1',
+ status_key => 'package',
+ status_value => 'foo',
+ bug => '2',
+ },
+ merge => {command => 'merge',
+ value => '1 2',
+ status_key => 'mergedwith',
+ status_value => '2',
+ },
+ unmerge => {command => 'unmerge',
+ value => '',
+ status_key => 'mergedwith',
+ status_value => '',
+ },
+ );
+
+test_control_commands(@control_commands);
+
+send_message(to => 'control@bugs.something',
+ headers => [To => 'control@bugs.something',
+ From => 'foo@bugs.something',
+ Subject => "Munging a bug with lots of stuff",
+ ],
+ body => <<'EOF') or fail 'message to control@bugs.something failed';
+debug 10
+clone 2 -1 -2 -3 -4
+retitle 2 foo
+owner 2 bar@baz.com
+submitter 2 fleb@bleh.com
+tag 2 unreproducible moreinfo
+severity 2 grave
+block -1 by 2
+block 2 by -2
+summary 2 4
+affects 2 bleargh
+forwarded 2 http://example.com/2
+close 2
+tag -3 wontfix
+thanks
+EOF
+ ;
+ $SD_SIZE =
+ num_messages_sent($SD_SIZE,1,
+ $sendmail_dir,
+ 'control@bugs.something messages appear to have been sent out properly');
+
+
+test_control_commands(forcemerge => {command => 'forcemerge',
+ value => '2',
+ status_key => 'mergedwith',
+ status_value => '2',
+ },
+ unmerge => {command => 'unmerge',
+ value => '',
+ status_key => 'mergedwith',
+ status_value => '',
+ },
+ forcemerge => {command => 'forcemerge',
+ value => '2 5',
+ status_key => 'mergedwith',
+ status_value => '2 5',
+ },
+ );
+
+
+sub test_control_commands{
+ my @commands = @_;
+
+ while (my ($command,$control_command) = splice(@commands,0,2)) {
+ # just check to see that control doesn't explode
+ $control_command->{value} = " $control_command->{value}" if length $control_command->{value}
+ and $control_command->{value} !~ /^\s/;
+ send_message(to => 'control@bugs.something',
+ headers => [To => 'control@bugs.something',
+ From => 'foo@bugs.something',
+ Subject => "Munging a bug with $command",
+ ],
+ body => <<EOF) or fail 'message to control@bugs.something failed';
+debug 10
+$control_command->{command} 1$control_command->{value}
+thanks
+EOF
+ ;
+ $SD_SIZE =
+ num_messages_sent($SD_SIZE,1,
+ $sendmail_dir,
+ 'control@bugs.something messages appear to have been sent out properly');
+ # now we need to check to make sure the control message was processed without errors
+ ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug with $command")) == 0,
+ 'control@bugs.something'. "$command message was parsed without errors");
+ # now we need to check to make sure that the control message actually did anything
+ my $status;
+ $status = read_bug(exists $control_command->{bug}?(bug => $control_command->{bug}):(bug=>1),
+ exists $control_command->{location}?(location => $control_command->{location}):(),
+ );
+ is_deeply($status->{$control_command->{status_key}},
+ $control_command->{status_value},
+ "bug " .
+ (exists $control_command->{bug}?$control_command->{bug}:1).
+ " $command"
+ )
+ or fail(Dumper($status));
+ }
+}
--
{
my %ref_handled;
-for my $bug ($ref,@refs) {
+for my $bug (sort ($ref,@refs)) {
next unless defined $bug;
next if exists $ref_handled{$bug};
$ref_handled{$bug} = 1;
This is an automatic notification regarding your {$config{bug}} report
which was filed against the {$data{package}} package:
-#{$ref}: {$data{subject}}
+#{$data{bug_num}}: {$data{subject}}
It has been closed by {$markedby}.
The submitter address recorded for your {$config{bug}} report
-#{$data->{bug_num}}: {$data->{subject}}
+#{$data{bug_num}}: {$data{subject}}
has been changed.
The old submitter address for this report was
-{$old_data->{submitter}}.
+{$old_data{originator}}.
+
The new submitter address is
-{$data->{submitter}}.
+{$data{originator}}.
This change was made by
{$replyto}.
projects / debbugs.git / commitdiff