X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl.pm;h=1f8b3aac60d3cb98fe5264795fc7806e795c4bac;hb=eeaa1c6b4d90ed620b53e92efef377446c0b9e8b;hp=95876245ba215b59ffe4e37682af88bf0e2db0c2;hpb=7d96d08af28cfc7a0619146d9b232d6b7ced0cf7;p=debbugs.git

diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index 9587624..1f8b3aa 100644
--- a/Debbugs/Control.pm
+++ b/Debbugs/Control.pm
@@ -75,7 +75,7 @@ is true, the above options must be present, and their values are used.
 use warnings;
 use strict;
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
 
 BEGIN{
      $VERSION = 1.00;
@@ -126,7 +126,7 @@ use IO::File;
 
 use Debbugs::Text qw(:templates);
 
-use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
+use Debbugs::Mail qw(rfc822_date send_mail_message default_headers encode_headers);
 use Debbugs::MIME qw(create_mime_message);
 
 use Mail::RFC822::Address qw();
@@ -134,7 +134,7 @@ use Mail::RFC822::Address qw();
 use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
-use List::Util qw(first max);
+use List::AllUtils qw(first max);
 use Encode qw(encode_utf8);
 
 use Carp;
@@ -364,7 +364,7 @@ sub set_blocks {
 	next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
 	my $data = read_bug(bug=>$blocker,
 			   );
-	if (defined $data and not $data->{archive}) {
+	if (defined $data and not $data->{archived}) {
 	    $data = split_status_fields($data);
 	    $ok_blockers{$blocker} = 1;
 	    my @merged_bugs;
@@ -379,15 +379,17 @@ sub set_blocks {
     # throw an error if we are setting the blockers and there is a bad
     # blocker
     if (keys %bad_blockers and $mode eq 'set') {
-	croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
-	    keys %ok_blockers?'':" and no known blocking bug(s)";
+	__end_control(%info);
+	croak "Unknown/archived blocking bug(s):".join(', ',keys %bad_blockers).
+	    keys %ok_blockers?'':" and no good blocking bug(s)";
     }
     # if there are no ok blockers and we are not setting the blockers,
     # there's an error.
     if (not keys %ok_blockers and $mode ne 'set') {
 	print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
 	if (keys %bad_blockers) {
-	    croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
+	    __end_control(%info);
+	    croak "Unknown/archived blocking bug(s):".join(', ',keys %bad_blockers);
 	}
 	__end_control(%info);
 	return;
@@ -410,6 +412,7 @@ sub set_blocks {
     @bugs{@bugs} = (1) x @bugs;
     for my $blocker (@change_blockers) {
 	if ($bugs{$blocker}) {
+	    __end_control(%info);
 	    croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
 	}
     }
@@ -444,7 +447,6 @@ sub set_blocks {
 	    }
 	}
     }
-    my @new_blockers = keys %blockers;
     for my $data (@data) {
 	my $old_data = dclone($data);
 	# remove blockers and/or add new ones as appropriate
@@ -487,9 +489,7 @@ sub set_blocks {
     $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
     my $new_locks = 0;
     for my $add_remove (keys %mungable_blocks) {
-	my @munge_blockers;
 	my %munge_blockers;
-	my $block_locks = 0;
 	for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
 	    next if $munge_blockers{$blocker};
 	    my ($temp_locks, @blocking_data) =
@@ -628,10 +628,8 @@ sub set_tag {
 	__begin_control(%param,
 			command  => 'tag'
 		       );
-    my ($debug,$transcript) =
-	@info{qw(debug transcript)};
+    my $transcript = $info{transcript};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my @tags = make_list($param{tag});
     if (not @tags and ($param{remove} or $param{add})) {
 	if ($param{remove}) {
@@ -649,11 +647,9 @@ sub set_tag {
 	my $action = 'Did not alter tags';
 	my %tag_added = ();
 	my %tag_removed = ();
-	my %fixed_removed = ();
 	my @old_tags = split /\,?\s+/, $data->{keywords};
 	my %tags;
 	@tags{@old_tags} = (1) x @old_tags;
-	my $reopened = 0;
 	my $old_data = dclone($data);
 	if (not $param{add} and not $param{remove}) {
 	    $tag_removed{$_} = 1 for @old_tags;
@@ -773,10 +769,8 @@ sub set_severity {
 	__begin_control(%param,
 			command  => 'severity'
 		       );
-    my ($debug,$transcript) =
-	@info{qw(debug transcript)};
+    my $transcript = $info{transcript};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
 
     my $action = '';
     for my $data (@data) {
@@ -878,10 +872,8 @@ sub set_done {
 	__begin_control(%param,
 			command  => $param{reopen}?'reopen':'done',
 		       );
-    my ($debug,$transcript) =
-	@info{qw(debug transcript)};
+    my $transcript = $info{transcript};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action ='';
 
     if ($param{reopen}) {
@@ -941,7 +933,6 @@ sub set_done {
     }
     else {
 	my %submitter_notified;
-	my $requester_notified = 0;
 	my $orig_report_set = 0;
 	for my $data (@data) {
 	    if (exists $data->{done} and
@@ -1100,7 +1091,6 @@ sub set_submitter {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     # here we only concern ourselves with the first of the merged bugs
     for my $data ($data[0]) {
@@ -1116,7 +1106,7 @@ sub set_submitter {
 	}
 	else {
 	    if (defined $data->{originator} and length($data->{originator})) {
-		$action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
+		$action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'.";
 		$notify_old_submitter = 1;
 	    }
 	    else {
@@ -1215,7 +1205,6 @@ sub set_forwarded {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     for my $data (@data) {
 	my $old_data = dclone($data);
@@ -1231,7 +1220,7 @@ sub set_forwarded {
 		$action= "Unset $config{bug} forwarded-to-address";
 	    }
 	    elsif (defined $data->{forwarded} and length($data->{forwarded})) {
-		$action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
+		$action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
 	    }
 	    else {
 		$action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
@@ -1304,7 +1293,6 @@ sub set_title {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     for my $data (@data) {
 	my $old_data = dclone($data);
@@ -1316,7 +1304,7 @@ sub set_title {
 	}
 	else {
 	    if (defined $data->{subject} and length($data->{subject})) {
-		$action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'";
+		$action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'.";
 	    } else {
 		$action= "Set $config{bug} title to '$param{title}'.";
 	    }
@@ -1399,7 +1387,6 @@ sub set_package {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     # clean up the new package
     my $new_package =
 	join(',',
@@ -1523,7 +1510,6 @@ sub set_found {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %versions;
     for my $version (make_list($param{found})) {
 	next unless defined $version;
@@ -1743,7 +1729,6 @@ sub set_fixed {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %versions;
     for my $version (make_list($param{fixed})) {
 	next unless defined $version;
@@ -1970,7 +1955,6 @@ sub set_merged {
 	return;
     }
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %data;
     my %merged_bugs;
     for my $data (@data) {
@@ -1981,7 +1965,6 @@ sub set_merged {
     # handle unmerging
     my $new_locks = 0;
     if (not exists $param{merge_with}) {
-	my $ok_to_unmerge = 1;
 	delete $merged_bugs{$param{bug}};
 	if (not keys %merged_bugs) {
 	    print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
@@ -1995,8 +1978,11 @@ sub set_merged {
 		$data->{mergedwith} = '';
 	    }
 	    else {
-		$data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
-					    keys %merged_bugs);
+		$data->{mergedwith} =
+		    join(' ',
+			 sort {$a <=> $b}
+			 grep {$_ != $data->{bug_num}}
+			 keys %merged_bugs);
 	    }
 	    append_action_to_log(bug => $data->{bug_num},
 				 command  => 'merge',
@@ -2015,9 +2001,6 @@ sub set_merged {
 	return;
     }
     # lock and load all of the bugs we need
-    my @bugs_to_load = keys %merging;
-    my $bug_to_load;
-    my %merge_added;
     my ($data,$n_locks) =
 	__lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
 				    data => \@data,
@@ -2090,9 +2073,11 @@ sub set_merged {
 		print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
 	    }
 	    if ($attempts > 0) {
+		__end_control(%info);
 		croak "Some bugs were altered while attempting to merge";
 	    }
 	    else {
+		__end_control(%info);
 		croak "Did not alter merged bugs";
 	    }
 	}
@@ -2104,12 +2089,12 @@ sub set_merged {
 		$param{show_bug_info} and not __internal_request(1);
 	    $bug_info_shown{$change_bug} = 1;
 	    __allow_relocking($param{locks},[keys %data]);
+	    eval {
 	    for my $change (@{$changes->{$change_bug}}) {
 		if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
 		    my %target_blockedby;
 		    @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
 		    my %unhandled_targets = %target_blockedby;
-		    my @blocks_to_remove;
 		    for my $key (split / /,$change->{orig_value}) {
 			delete $unhandled_targets{$key};
 			next if exists $target_blockedby{$key};
@@ -2141,6 +2126,12 @@ sub set_merged {
 					 );
 		}
 	    }
+	};
+	    if ($@) {
+		__disallow_relocking($param{locks});
+		__end_control(%info);
+		croak "Failure while trying to adjust bugs, please report this as a bug: $@";
+	    }
 	    __disallow_relocking($param{locks});
 	    my ($data,$n_locks) =
 		__lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
@@ -2181,11 +2172,14 @@ sub set_merged {
     }
 
     # finally, we can merge the bugs
-    my $action = "Merged ".join(' ',sort keys %merged_bugs);
+    my $action = "Merged ".join(' ',sort { $a <=> $b } keys %merged_bugs);
     for my $data (@data) {
 	my $old_data = dclone($data);
-	$data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
-				    keys %merged_bugs);
+	$data->{mergedwith} =
+	    join(' ',
+		 sort { $a <=> $b }
+		 grep {$_ != $data->{bug_num}}
+		 keys %merged_bugs);
 	append_action_to_log(bug => $data->{bug_num},
 			     command  => 'merge',
 			     new_data => $data,
@@ -2304,13 +2298,22 @@ sub __calculate_merge_status{
 	    $merged_bugs{$data->{bug_num}} = 1;
 	    $bugs_to_merge = 1;
 	}
+    }
+    for my $data (@{$data_a}) {
 	# the master_bug is the bug that every other bug is made to
 	# look like. However, if merge is set, tags, fixed and found
 	# are merged.
 	if ($data->{bug_num} == $master_bug) {
-	    for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
+	    for (qw(package forwarded severity done owner summary outlook affects)) {
 		$merge_status{$_} = $data->{$_}
 	    }
+	    # bugs which are in the newly merged set and are also
+	    # blocks/blockedby must be removed before merging
+ 	    for (qw(blocks blockedby)) {
+ 		$merge_status{$_} =
+ 		    join(' ',grep {not exists $merged_bugs{$_}}
+ 			 split / /,$data->{$_});
+ 	    }
 	}
  	if (defined $merge_status) {
  	    next unless $data->{bug_num} == $master_bug;
@@ -2560,7 +2563,6 @@ sub affects {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     for my $data (@data) {
 	$action = '';
@@ -2663,7 +2665,7 @@ Handles all setting of summary fields
 
 If summary is undef, unsets the summary
 
-If summary is 0, sets the summary to the first paragraph contained in
+If summary is 0 or -1, sets the summary to the first paragraph contained in
 the message passed.
 
 If summary is a positive integer, sets the summary to the message specified.
@@ -2738,7 +2740,6 @@ sub _summary {
     my ($debug,$transcript) =
 	@info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     # figure out the log that we're going to use
     my $summary = '';
     my $summary_msg = '';
@@ -2748,10 +2749,10 @@ sub _summary {
 	 print {$debug} "Removing $cmd fields\n";
 	 $action = "Removed $cmd";
     }
-    elsif ($param{$cmd} =~ /^\d+$/) {
+    elsif ($param{$cmd} =~ /^-?\d+$/) {
 	 my $log = [];
 	 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
-	 if ($param{$cmd} == 0) {
+	 if ($param{$cmd} == 0 or $param{$cmd} == -1) {
 	      $log = $param{message};
 	      $summary_msg = @records + 1;
 	 }
@@ -2785,12 +2786,13 @@ sub _summary {
 	      }
 	      # skip a paragraph if it looks like it's control or
 	      # pseudo-headers
-	      if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+	      if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
 		  $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
 				 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
 				 debug|(?:not|)forwarded|priority|
 				 (?:un|)block|limit|(?:un|)archive|
-				 reassign|retitle|affects|wrongpackage
+				 reassign|retitle|affects|package|
+				 outlook|
 				 (?:un|force|)merge|user(?:category|tags?|)
 			     )\s+\S}xis) {
 		   if (not length $paragraph) {
@@ -2894,10 +2896,8 @@ sub clone_bug {
 	__begin_control(%param,
 			command  => 'clone'
 		       );
-    my ($debug,$transcript) =
-	@info{qw(debug transcript)};
+    my $transcript = $info{transcript};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
 
     my $action = '';
     for my $data (@data) {
@@ -2963,19 +2963,21 @@ sub clone_bug {
     # bugs that this bug is blocking are also blocked by the new clone(s)
     for my $bug (split ' ', $data->{blocks}) {
 	for my $new_bug (@new_bugs) {
-	    set_blocks(bug => $new_bug,
-		       block => $bug,
+	    set_blocks(bug => $bug,
+		       block => $new_bug,
+		       add => 1,
 		       hash_slice(%param,
 				  keys %common_options,
 				  keys %append_action_options),
 		      );
 	}
     }
-    # bugs that this bug is blocked by are also blocking the new clone(s)
+    # bugs that are blocking this bug are also blocking the new clone(s)
     for my $bug (split ' ', $data->{blockedby}) {
 	for my $new_bug (@new_bugs) {
-	    set_blocks(bug => $bug,
-		       block => $new_bug,
+	    set_blocks(bug => $new_bug,
+		       block => $bug,
+		       add => 1,
 		       hash_slice(%param,
 				  keys %common_options,
 				  keys %append_action_options),
@@ -3029,7 +3031,6 @@ sub owner {
      my ($debug,$transcript) =
 	@info{qw(debug transcript)};
      my @data = @{$info{data}};
-     my @bugs = @{$info{bugs}};
      my $action = '';
      for my $data (@data) {
 	  print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
@@ -3242,10 +3243,18 @@ sub bug_unarchive {
 				command=>'unarchive');
      my ($debug,$transcript) =
 	 @info{qw(debug transcript)};
-     my @data = @{$info{data}};
      my @bugs = @{$info{bugs}};
      my $action = "$config{bug} unarchived.";
      my @files_to_remove;
+     ## error out if we're unarchiving unarchived bugs
+     for my $data (@{$info{data}}) {
+	 if (not defined $data->{archived} or
+	     not $data->{archived}
+	    ) {
+	     __end_control(%info);
+	     croak("Bug $data->{bug_num} was not archived; not unarchiving it.");
+	 }
+     }
      for my $bug (@bugs) {
 	  print {$debug} "$param{bug} removing $bug\n";
 	  my $dir = get_hashname($bug);
@@ -3467,7 +3476,7 @@ sub append_action_to_log{
      $msg = '';
      if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
 	 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
-			 exists $param{recips}?(recips => [make_list($param{recips})]):(),
+			 exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(),
 			 text => join('',make_list($param{message})),
 			};
      }
@@ -3591,13 +3600,14 @@ sub __return_append_to_log_options{
      }
      if (not exists $param{message}) {
 	  my $date = rfc822_date();
-	  $param{message} = fill_in_template(template  => 'mail/fake_control_message',
-					     variables => {request_addr => $param{request_addr},
-							   requester    => $param{requester},
-							   date         => $date,
-							   action       => $action
-							  },
-					    );
+	  $param{message} =
+              encode_headers(fill_in_template(template  => 'mail/fake_control_message',
+                                              variables => {request_addr => $param{request_addr},
+                                                            requester    => $param{requester},
+                                                            date         => $date,
+                                                            action       => $action
+                                                           },
+                                             ));
      }
      if (not defined $action) {
 	  carp "Undefined action!";
@@ -3819,7 +3829,7 @@ LIMIT:	    for my $limit (make_list($param{limit}{$field})) {
 	    }
 	    if (not $match) {
 		$going_to_fail = 1;
-		print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
+		print {$transcript} qq($field: ').join(', ',map{qq("$_")} make_list($data->{$field})).
 		    "' does not match at least one of ".
 		    join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
 	    }
@@ -3862,7 +3872,7 @@ sub __message_body_template{
      $extra_var ||={};
      my $hole_var = {'&bugurl' =>
 		     sub{"$_[0]: ".
-			     'http://'.$config{cgi_domain}.'/'.
+			     $config{cgi_domain}.'/'.
 				 Debbugs::CGI::bug_links(bug => $_[0],
 							 links_only => 1,
 							);