From: Debian BTS Date: Tue, 13 Mar 2012 22:24:31 +0000 (+0000) Subject: merge changes from dla source branch X-Git-Tag: release/2.6.0~415 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=6edbdb47edfa0db4c2cd290a7f6cf8b2c9b2b121;hp=cfd3e0e6967532e9deafb74615134cc8c3255e16;p=debbugs.git merge changes from dla source branch --- diff --git a/Debbugs/Bugs.pm b/Debbugs/Bugs.pm index 573bf51..e4f8cc8 100644 --- a/Debbugs/Bugs.pm +++ b/Debbugs/Bugs.pm @@ -325,7 +325,7 @@ sub bug_filter { optional => 1, }, repeat_merged => {type => BOOLEAN, - optional => 1, + default => 1, }, include => {type => HASHREF, optional => 1, diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index ef1b8bb..915fa85 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -39,7 +39,7 @@ BEGIN{ @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), @@ -48,6 +48,7 @@ BEGIN{ ], misc => [qw(make_list globify_scalar english_join checkpid), qw(cleanup_eval_fail), + qw(hash_slice), ], date => [qw(secs_to_english)], quit => [qw(quit)], @@ -61,6 +62,7 @@ BEGIN{ #use Debbugs::Config qw(:globals); use Carp; +$Carp::Verbose = 1; use Debbugs::Config qw(:config); use IO::File; @@ -71,7 +73,7 @@ use Cwd qw(cwd); 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; @@ -216,6 +218,28 @@ sub appendfile { 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); @@ -508,20 +532,44 @@ These functions are exported with the :lock tag =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 (;;) { @@ -537,13 +585,19 @@ sub filelock { } 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; } } @@ -558,6 +612,7 @@ END { =head2 unfilelock unfilelock() + unfilelock($locks); Unlocks the file most recently locked. @@ -567,10 +622,24 @@ locked with filelock. =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}: $!"; @@ -601,7 +670,7 @@ sub lockpid { 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 $!"; @@ -806,6 +875,22 @@ sub cleanup_eval_fail { 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; diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm index ae4c04f..f4761a0 100644 --- a/Debbugs/Config.pm +++ b/Debbugs/Config.pm @@ -103,7 +103,7 @@ use Safe; # 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; } @@ -1025,7 +1025,7 @@ set_default(\%config,'html_expire_note', 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. diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm index 4ec2a10..78efdf1 100644 --- a/Debbugs/Control.pm +++ b/Debbugs/Control.pm @@ -82,7 +82,7 @@ BEGIN{ $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)], @@ -94,7 +94,9 @@ BEGIN{ fixed => [qw(set_found set_fixed)], package => [qw(set_package)], block => [qw(set_blocks)], + merge => [qw(set_merged)], tag => [qw(set_tag)], + clone => [qw(clone_bug)], archive => [qw(bug_archive bug_unarchive), ], log => [qw(append_action_to_log), @@ -107,14 +109,16 @@ BEGIN{ 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); @@ -127,7 +131,7 @@ use Mail::RFC822::Address qw(); use POSIX qw(strftime); use Storable qw(dclone nfreeze); -use List::Util qw(first); +use List::Util qw(first max); use Carp; @@ -166,6 +170,9 @@ my %common_options = (debug => {type => SCALARREF|HANDLE, request_replyto => {type => SCALAR, optional => 1, }, + locks => {type => HASHREF, + optional => 1, + }, ); @@ -191,8 +198,15 @@ my %append_action_options = qw(message), ], }, + # locks is both an append_action option, and a common option; + # it's ok for it to be in both places. + locks => {type => HASHREF, + optional => 1, + }, ); +our $locks = 0; + # this is just a generic stub for Debbugs::Control functions. # @@ -431,9 +445,14 @@ sub set_blocks { 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; @@ -463,17 +482,25 @@ sub set_blocks { my %mungable_blocks; $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers; $mungable_blocks{add} = \%added_blockers if keys %added_blockers; + my $new_locks = 0; for my $add_remove (keys %mungable_blocks) { my @munge_blockers; my %munge_blockers; my $block_locks = 0; for my $blocker (keys %{$mungable_blocks{$add_remove}}) { next if $munge_blockers{$blocker}; - my ($new_locks, @blocking_data) = - lock_read_all_merged_bugs($blocker, - ($param{archived}?'archive':())); + my ($temp_locks, @blocking_data) = + lock_read_all_merged_bugs(bug => $blocker, + ($param{archived}?(location => 'archive'):()), + exists $param{locks}?(locks => $param{locks}):(), + ); + $locks+= $temp_locks; + $new_locks+=$temp_locks; if (not @blocking_data) { - unfilelock() for $new_locks; + for (1..$new_locks) { + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; + } die "Unable to get file lock while trying to $add_remove blocker '$blocker'"; } for (map {$_->{bug_num}} @blocking_data) { @@ -519,7 +546,10 @@ sub set_blocks { transcript => $transcript, ); - unfilelock() for $new_locks; + for (1..$new_locks) { + unfilelock(exists $param{locks}?$param{locks}:()); + $locks--; + } } } __end_control(%info); @@ -710,7 +740,7 @@ sub set_tag { } Sets the severity of a bug. If severity is not passed, is undefined, -or has zero length, sets the severity to the defafult severity. +or has zero length, sets the severity to the default severity. =cut @@ -750,7 +780,7 @@ sub set_severity { for my $data (@data) { if (not defined $data->{severity}) { $data->{severity} = $param{severity}; - $action = "Severity set to '$param{severity}'\n"; + $action = "Severity set to '$param{severity}'"; } else { if ($data->{severity} eq '') { @@ -760,7 +790,7 @@ sub set_severity { print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n"; next; } - $action = "Severity set to '$param{severity}' from '$data->{severity}'\n"; + $action = "Severity set to '$param{severity}' from '$data->{severity}'"; $data->{severity} = $param{severity}; } append_action_to_log(bug => $data->{bug_num}, @@ -778,19 +808,18 @@ sub set_severity { } -=head2 reopen +=head2 set_done eval { - set_foo(bug => $ref, - transcript => $transcript, - ($dl > 0 ? (debug => $transcript):()), - requester => $header{from}, - request_addr => $controlrequestaddr, - message => \@log, - affected_packages => \%affected_packages, - recipients => \%recipients, - summary => undef, - ); + set_done(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + ); }; if ($@) { $errors++; @@ -801,31 +830,51 @@ Foo frobinates =cut -sub reopen { +sub set_done { my %param = validate_with(params => \@_, spec => {bug => {type => SCALAR, regex => qr/^\d+$/, }, - # specific options here - submitter => {type => SCALAR|UNDEF, - default => undef, + reopen => {type => BOOLEAN, + default => 0, }, + submitter => {type => SCALAR, + optional => 1, + }, + clear_fixed => {type => BOOLEAN, + default => 1, + }, + notify_submitter => {type => BOOLEAN, + default => 1, + }, + original_report => {type => SCALARREF, + optional => 1, + }, + done => {type => SCALAR|UNDEF, + optional => 1, + }, %common_options, %append_action_options, }, ); - $param{submitter} = undef if defined $param{submitter} and - not length $param{submitter}; - - if (defined $param{submitter} and + if (exists $param{submitter} and not Mail::RFC822::Address::valid($param{submitter})) { - die "New submitter address $param{submitter} is not a valid e-mail address"; + die "New submitter address '$param{submitter}' is not a valid e-mail address"; + } + if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address + $param{done} = $param{requester}; + } + if (exists $param{done} and + (not defined $param{done} or + not length $param{done})) { + delete $param{done}; + $param{reopen} = 1; } my %info = __begin_control(%param, - command => 'reopen' + command => $param{reopen}?'reopen':'done', ); my ($debug,$transcript) = @info{qw(debug transcript)}; @@ -833,45 +882,169 @@ sub reopen { 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, - ); } @@ -1033,6 +1206,7 @@ sub set_forwarded { if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) { die "Non-printable characters are not allowed in the forwarded field"; } + $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded}; my %info = __begin_control(%param, command => 'forwarded' @@ -1045,9 +1219,9 @@ sub set_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; @@ -1470,7 +1644,7 @@ sub set_found { push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed; # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added; push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed; - $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed; + $action = ucfirst(join ('; ',@changed)) if @changed; if ($reopened) { $action .= " and reopened" } @@ -1679,7 +1853,7 @@ sub set_fixed { push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed; push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added; push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed; - $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed; + $action = ucfirst(join ('; ',@changed)) if @changed; if ($reopened) { $action .= " and reopened" } @@ -1707,6 +1881,569 @@ sub set_fixed { } +=head2 set_merged + + eval { + set_merged(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + merge_with => 12345, + add => 1, + force => 1, + allow_reassign => 1, + reassign_same_source_only => 1, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to set merged on $ref: $@"; + } + + +Sets, adds, or removes the specified merged bugs of a bug + +By default, requires + +=cut + +sub set_merged { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + # specific options here + merge_with => {type => ARRAYREF|SCALAR, + optional => 1, + }, + remove => {type => BOOLEAN, + default => 0, + }, + force => {type => BOOLEAN, + default => 0, + }, + masterbug => {type => BOOLEAN, + default => 0, + }, + allow_reassign => {type => BOOLEAN, + default => 0, + }, + reassign_different_sources => {type => BOOLEAN, + default => 1, + }, + %common_options, + %append_action_options, + }, + ); + my @merging = exists $param{merge_with} ? make_list($param{merge_with}):(); + my %merging; + @merging{@merging} = (1) x @merging; + if (grep {$_ !~ /^\d+$/} @merging) { + croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging); + } + $param{locks} = {} if not exists $param{locks}; + my %info = + __begin_control(%param, + command => 'merge' + ); + my ($debug,$transcript) = + @info{qw(debug transcript)}; + if (not @merging and exists $param{merge_with}) { + print {$transcript} "Requested to merge with no additional bugs; not doing anything\n"; + __end_control(%info); + return; + } + my @data = @{$info{data}}; + my @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 @@ -1745,9 +2482,9 @@ sub affects { regex => qr/^\d+$/, }, # specific options here - packages => {type => SCALAR|ARRAYREF, - default => [], - }, + package => {type => SCALAR|ARRAYREF|UNDEF, + default => [], + }, add => {type => BOOLEAN, default => 0, }, @@ -1761,6 +2498,9 @@ sub affects { if ($param{add} and $param{remove}) { croak "Asking to both add and remove affects is nonsensical"; } + if (not defined $param{package}) { + $param{package} = []; + } my %info = __begin_control(%param, command => 'affects' @@ -1778,7 +2518,7 @@ sub affects { @packages{@packages} = (1) x @packages; if ($param{add}) { my @added = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { next unless defined $package and length $package; if (not $packages{$package}) { $packages{$package} = 1; @@ -1792,7 +2532,7 @@ sub affects { } elsif ($param{remove}) { my @removed = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { if ($packages{$package}) { next unless defined $package and length $package; delete $packages{$package}; @@ -1806,7 +2546,7 @@ sub affects { my %added_packages = (); my %removed_packages = %packages; %packages = (); - for my $package (make_list($param{packages})) { + for my $package (make_list($param{package})) { next unless defined $package and length $package; $packages{$package} = 1; delete $removed_packages{$package}; @@ -1825,6 +2565,7 @@ sub affects { if (not length $action) { print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n" unless __internal_request(); + next; } my $old_data = dclone($data); $data->{affects} = join(',',keys %packages); @@ -1874,8 +2615,9 @@ If summary is undef, unsets the summary 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 @@ -1893,8 +2635,8 @@ sub summary { %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' @@ -1912,7 +2654,7 @@ sub 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) { @@ -1975,6 +2717,9 @@ sub summary { # 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 @@ -2013,6 +2758,140 @@ sub summary { +=head2 clone_bug + + eval { + clone_bug(bug => $ref, + transcript => $transcript, + ($dl > 0 ? (debug => $transcript):()), + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + affected_packages => \%affected_packages, + recipients => \%recipients, + ); + }; + if ($@) { + $errors++; + print {$transcript} "Failed to clone bug $ref bar: $@"; + } + +Clones the given bug. + +We currently don't support cloning merged bugs, but this could be +handled by internally unmerging, cloning, then remerging the bugs. + +=cut + +sub clone_bug { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+$/, + }, + new_bugs => {type => ARRAYREF, + }, + new_clones => {type => HASHREF, + default => {}, + }, + %common_options, + %append_action_options, + }, + ); + my %info = + __begin_control(%param, + command => 'clone' + ); + my ($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 @@ -2232,7 +3111,7 @@ sub bug_archive { print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n"; } unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove); - print {$transcript} "deleted $bug (from $param{bug})\n"; + print {$debug} "deleted $bug (from $param{bug})\n"; } bughook_archive(@bugs); __end_control(%info); @@ -2353,12 +3232,18 @@ sub append_action_to_log{ message => {type => SCALAR|ARRAYREF, default => '', }, + recips => {type => SCALAR|ARRAYREF, + optional => 1 + }, desc => {type => SCALAR, default => '', }, get_lock => {type => BOOLEAN, default => 1, }, + locks => {type => HASHREF, + optional => 1, + }, # we don't use # append_action_options here # because some of these @@ -2373,10 +3258,12 @@ sub append_action_to_log{ die "Unable to find .log for $param{bug}" if not defined $log_location; if ($param{get_lock}) { - filelock("lock/$param{bug}"); + filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:()); + $locks++; } - my $log = IO::File->new(">>$log_location") or - die "Unable to open $log_location for appending: $!"; + my @records; + my $logfh = IO::File->new(">>$log_location") or + die "Unable to open $log_location for appending: $!"; # determine difference between old and new my $data_diff = ''; if (exists $param{old_data} and exists $param{new_data}) { @@ -2397,7 +3284,6 @@ sub append_action_to_log{ ref($old_data->{$key}) and ref($new_data->{$key}) eq ref($old_data->{$key})) { local $Storable::canonical = 1; - # print STDERR Dumper($new_data,$old_data,$key); if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) { delete $new_data->{$key}; delete $old_data->{$key}; @@ -2459,7 +3345,7 @@ sub append_action_to_log{ $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} ? "\n":"" ), @@ -2484,15 +3370,23 @@ sub append_action_to_log{ 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--; } @@ -2619,8 +3513,7 @@ 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), ); } @@ -2657,7 +3550,7 @@ corresponding to this request =cut -our $locks = 0; +our $lockhash; sub __begin_control { my %param = validate_with(params => \@_, @@ -2677,13 +3570,16 @@ sub __begin_control { 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."; @@ -2727,6 +3623,7 @@ sub __begin_control { debug => $debug, transcript => $transcript, param => \%param, + exists $param{locks}?(locks => $param{locks}):(), ); } @@ -2743,12 +3640,13 @@ sub __end_control { if (exists $info{new_locks} and $info{new_locks} > 0) { print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n"; for (1..$info{new_locks}) { - unfilelock(); + unfilelock(exists $info{locks}?$info{locks}:()); + $locks--; } } $SIG{__DIE__} = $info{old_die}; - if (exists $info{param}{bugs_affected}) { - @{$info{param}{bugs_affected}}{@{$info{bugs}}} = (1) x @{$info{bugs}}; + if (exists $info{param}{affected_bugs}) { + @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}}; } add_recipients(recipients => $info{param}{recipients}, (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()), @@ -2850,12 +3748,12 @@ matter.] =cut sub sig_die{ - #if ($^S) { # in eval + if ($^S) { # in eval if ($locks) { - for (1..$locks) { unfilelock(); } + for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); } $locks = 0; } - #} + } } @@ -2892,6 +3790,25 @@ sub __message_body_template{ ); } +sub __all_undef_or_equal { + my @values = @_; + return 1 if @values == 1 or @values == 0; + my $not_def = grep {not defined $_} @values; + if ($not_def == @values) { + return 1; + } + if ($not_def > 0 and $not_def != @values) { + return 0; + } + my $first_val = shift @values; + for my $val (@values) { + if ($first_val ne $val) { + return 0; + } + } + return 1; +} + 1; diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm index 268958e..af80f7a 100644 --- a/Debbugs/Log.pm +++ b/Debbugs/Log.pm @@ -37,7 +37,7 @@ BEGIN { 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 @@ -344,36 +344,72 @@ format representation of those records to that filehandle. =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'"; } } diff --git a/Debbugs/Mail.pm b/Debbugs/Mail.pm index c19be79..ad2df8c 100644 --- a/Debbugs/Mail.pm +++ b/Debbugs/Mail.pm @@ -43,7 +43,7 @@ use base qw(Exporter); 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); @@ -204,7 +204,7 @@ sub default_headers { # 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); @@ -250,7 +250,7 @@ sub default_headers { ($header,$default_header{$header}); } else { - push @other_headers,($header,$header_order{lc($header)}); + push @other_headers,($header,$default_header{$header}); } } my @headers; diff --git a/Debbugs/Recipients.pm b/Debbugs/Recipients.pm index 8ab2208..47c6485 100644 --- a/Debbugs/Recipients.pm +++ b/Debbugs/Recipients.pm @@ -94,6 +94,9 @@ sub add_recipients { actions_taken => {type => HASHREF, default => {}, }, + unknown_packages => {type => HASHREF, + default => {}, + }, }, ); @@ -103,7 +106,7 @@ sub add_recipients { 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; @@ -155,7 +158,10 @@ sub add_recipients { } 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}, diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index 8b4b9b0..0d97a32 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -44,6 +44,7 @@ use Debbugs::Packages qw(makesourceversions make_source_versions getversions get 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); @@ -62,6 +63,7 @@ BEGIN{ qw(lock_read_all_merged_bugs), ], write => [qw(writebug makestatus unlockwritebug)], + new => [qw(new_bug)], versions => [qw(addfoundversions addfixedversions), qw(removefoundversions removefixedversions) ], @@ -69,7 +71,7 @@ BEGIN{ 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]; } @@ -143,6 +145,10 @@ path to the summary file instead of the bug number and/or location. something modifying it while the bug has been read. You B call C 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 or C must be passed. This function will return @@ -171,6 +177,9 @@ sub read_bug{ lock => {type => BOOLEAN, optional => 1, }, + locks => {type => HASHREF, + optional => 1, + }, }, ); die "One of bug or summary must be passed to read_bug" @@ -197,13 +206,13 @@ sub 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; } @@ -223,7 +232,7 @@ sub read_bug{ if ($version > 3) { warn "Unsupported status version '$version'"; if ($param{lock}) { - unfilelock(); + unfilelock(exists $param{locks}?$param{locks}:()); } return undef; } @@ -435,9 +444,24 @@ even if all of the others were read properly. =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,()); } @@ -445,46 +469,112 @@ sub lock_read_all_merged_bugs { 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); @@ -608,7 +698,7 @@ options mean. sub unlockwritebug { writebug(@_); - &unfilelock; + unfilelock(); } =head1 VERSIONS @@ -845,7 +935,7 @@ sub bug_archiveable{ } # 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; @@ -890,7 +980,7 @@ sub bug_archiveable{ @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; @@ -1198,7 +1288,7 @@ sub bug_presence { (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; @@ -1506,23 +1596,23 @@ sub update_realtime { 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}; @@ -1540,7 +1630,7 @@ sub bughook { } update_realtime("$config{spool_dir}/index.db.realtime", %bugs); - &unfilelock; + unfilelock(); } diff --git a/Debbugs/Text.pm b/Debbugs/Text.pm index 61c7781..3df0e63 100644 --- a/Debbugs/Text.pm +++ b/Debbugs/Text.pm @@ -165,6 +165,7 @@ sub fill_in_template{ qw(rv2gv refgen srefgen ref), qw(caller require entereval), qw(gmtime time sprintf prtf), + qw(sort), ); $safe->share('*STDERR'); $safe->share('%config'); diff --git a/bin/add_bug_to_estraier b/bin/add_bug_to_estraier index 381b7d7..a83699a 100755 --- a/bin/add_bug_to_estraier +++ b/bin/add_bug_to_estraier @@ -23,6 +23,13 @@ add_bug_to_estraier -- add a bug log to an estraier database 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 diff --git a/bin/local-debbugs b/bin/local-debbugs index cae7203..b75d55f 100755 --- a/bin/local-debbugs +++ b/bin/local-debbugs @@ -374,7 +374,7 @@ elsif ($options{search}) { 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; } diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 8692146..8ad688f 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -1,8 +1,13 @@ -#!/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; diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi index b70a5cb..4f4ea80 100755 --- a/cgi/pkgreport.cgi +++ b/cgi/pkgreport.cgi @@ -13,6 +13,11 @@ 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); diff --git a/debian/changelog b/debian/changelog index 923c161..321f032 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +debbugs (2.4.2~exp2) experimental; urgency=low + + * Hack around elinks css bug (closes: #593804) + + -- Don Armstrong 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: @@ -29,8 +35,11 @@ debbugs (2.4.2~exp1) experimental; urgency=low 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 Wed, 26 Aug 2009 21:32:53 -0700 + -- Don Armstrong Thu, 05 Aug 2010 21:54:12 -0700 debbugs (2.4.2~exp0) experimental; urgency=low diff --git a/debian/control b/debian/control index 376b66c..a4550fa 100644 --- a/debian/control +++ b/debian/control @@ -66,7 +66,7 @@ Description: web scripts for the active Debian BTS 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 diff --git a/examples/debian/versions/build-mldbm.pl b/examples/debian/versions/build-mldbm.pl index f8bc3c2..9bcf44b 100755 --- a/examples/debian/versions/build-mldbm.pl +++ b/examples/debian/versions/build-mldbm.pl @@ -25,7 +25,9 @@ while (<>) { 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 diff --git a/examples/debian/versions/rebuild-debinfo b/examples/debian/versions/rebuild-debinfo new file mode 100755 index 0000000..213f4bc --- /dev/null +++ b/examples/debian/versions/rebuild-debinfo @@ -0,0 +1,60 @@ +#! /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; + } +} diff --git a/examples/hyperestraier_config b/examples/hyperestraier_config new file mode 100644 index 0000000..86ef7f6 --- /dev/null +++ b/examples/hyperestraier_config @@ -0,0 +1,15 @@ +## 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 diff --git a/html/bugs.css b/html/bugs.css index b61e5b1..db1d34b 100644 --- a/html/bugs.css +++ b/html/bugs.css @@ -9,12 +9,16 @@ html { } 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; } diff --git a/scripts/process b/scripts/process index b8efcc5..cab73b3 100755 --- a/scripts/process +++ b/scripts/process @@ -16,12 +16,12 @@ use Debbugs::MIME qw(decode_rfc1522 create_mime_message getmailbody); 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); @@ -265,8 +265,7 @@ if (defined $pheader{source}) { $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; @@ -301,7 +300,7 @@ if ($codeletter eq 'D' || $codeletter eq 'F') push @generalcc, "$gForwardList\@$gListDomain"; $generalcc= "$gForwardList\@$gListDomain"; } else { - $generalcc=''; + $generalcc=''; } } else { # Done if (defined $data->{done} and length($data->{done}) and @@ -512,6 +511,9 @@ if ($ref<0) { # new bug report $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}, } @@ -589,14 +591,8 @@ if ($ref<0) { # new bug report if (defined($pheader{forwarded})) { $data->{forwarded} = $pheader{forwarded}; } - &filelock("nextnumber.lock"); - open(N,"nextnumber") || die "nextnumber: read: $!"; - my $nextnumber=; $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; @@ -630,8 +626,8 @@ if ($ref<0) { # new bug report ); } } - &overwrite("db-h/$hash/$ref.report", - join("\n",@msg)."\n"); + overwritefile("db-h/$hash/$ref.report", + map {"$_\n"} @msg); } &checkmaintainers; @@ -899,14 +895,6 @@ if (not exists $header{'x-debbugs-no-ack'} and &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")) { @@ -997,12 +985,14 @@ sub sendmessage { 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; diff --git a/scripts/service b/scripts/service index 89ff785..eb10acd 100755 --- a/scripts/service +++ b/scripts/service @@ -135,6 +135,7 @@ my @common_control_options = request_nn => $nn, request_replyto => $replyto, message => \@log, + affected_bugs => \%bug_affected, affected_packages => \%affected_packages, recipients => \%recipients, limit => \%limit, @@ -465,69 +466,35 @@ END } #### "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= <{originator} -Subject: $gBug#$ref acknowledged by developer - ($header{'subject'}) -References: $header{'message-id'} $data->{msgid} -In-Reply-To: $data->{msgid} -Message-ID: -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}\/)? @@ -546,7 +513,6 @@ END } @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, @@ -570,7 +536,6 @@ END $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 '=') { @@ -581,10 +546,11 @@ END } } eval { - reopen(@common_control_options, - bug => $ref, - submitter => $new_submitter, - ); + set_done(@common_control_options, + bug => $ref, + reopen => 1, + submitter => $new_submitter, + ); }; if ($@) { $errors++; @@ -704,7 +670,6 @@ END 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)) { @@ -728,7 +693,6 @@ END $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, @@ -743,7 +707,6 @@ END $ok++; $ref= $1; $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; eval { set_forwarded(@common_control_options, bug => $ref, @@ -758,7 +721,6 @@ END $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. " . @@ -785,7 +747,6 @@ END $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 @@ -854,7 +815,6 @@ END 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, @@ -870,7 +830,6 @@ END $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, @@ -884,162 +843,48 @@ END } 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++; @@ -1048,62 +893,23 @@ END 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=; $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++; @@ -1153,11 +959,10 @@ END 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):()), ); @@ -1172,7 +977,6 @@ END $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, @@ -1192,7 +996,6 @@ END if ($newowner eq '!') { $newowner = $replyto; } - $bug_affected{$ref} = 1; eval { owner(@common_control_options, bug => $ref, @@ -1207,7 +1010,6 @@ END $ok++; $ref = $1; $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; eval { owner(@common_control_options, bug => $ref, @@ -1222,7 +1024,6 @@ END $ok++; $ref = $1; $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; eval { bug_unarchive(@common_control_options, bug => $ref, @@ -1236,7 +1037,6 @@ END $ok++; $ref = $1; $ref = $clonebugs{$ref} if exists $clonebugs{$ref}; - $bug_affected{$ref} = 1; eval { bug_archive(@common_control_options, bug => $ref, @@ -1353,7 +1153,7 @@ sub fill_template{ 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' => diff --git a/t/02_version_dpkg.t b/t/02_version_dpkg.t index a5865a0..f435bef 100644 --- a/t/02_version_dpkg.t +++ b/t/02_version_dpkg.t @@ -40,13 +40,13 @@ my @versions = ({a => '1.0-1', 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', }, diff --git a/t/12_merge.t b/t/12_merge.t new file mode 100644 index 0000000..5b76f72 --- /dev/null +++ b/t/12_merge.t @@ -0,0 +1,233 @@ +# -*- 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 => < '1@bugs.something', + headers => [To => '1@bugs.something', + From => 'foo@bugs.something', + Subject => 'Sending a message to a bug', + ], + body => < 'control@bugs.something', + headers => [To => 'control@bugs.something', + From => 'foo@bugs.something', + Subject => 'Munging a bug', + ], + body => <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 => <{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)); + } +} diff --git a/templates/en_US/mail/footer.tmpl b/templates/en_US/mail/footer.tmpl index 211a058..132201f 100644 --- a/templates/en_US/mail/footer.tmpl +++ b/templates/en_US/mail/footer.tmpl @@ -1,7 +1,7 @@ -- { 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; diff --git a/templates/en_US/mail/process_your_bug_done.tmpl b/templates/en_US/mail/process_your_bug_done.tmpl index 7f90a87..f01e5b0 100644 --- a/templates/en_US/mail/process_your_bug_done.tmpl +++ b/templates/en_US/mail/process_your_bug_done.tmpl @@ -1,7 +1,7 @@ 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}. diff --git a/templates/en_US/mail/submitter_changed.tmpl b/templates/en_US/mail/submitter_changed.tmpl index 1f0a9c0..c7032f1 100644 --- a/templates/en_US/mail/submitter_changed.tmpl +++ b/templates/en_US/mail/submitter_changed.tmpl @@ -1,11 +1,12 @@ 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}.