]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Control.pm
Include the protocol (http://) in gWebDomain and gCGIDomain
[debbugs.git] / Debbugs / Control.pm
index 74653b0a66e5d5d56210c60f0dbba16220d570f7..aaa8925a0adfedf8f33ab86be49d9e5a35f28d08 100644 (file)
@@ -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;
@@ -110,7 +110,8 @@ BEGIN{
 }
 
 use Debbugs::Config qw(:config);
-use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
+use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
+use Debbugs::UTF8;
 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::Log qw(:misc :write);
@@ -125,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();
@@ -443,7 +444,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
@@ -486,9 +486,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) =
@@ -627,10 +625,8 @@ sub set_tag {
        __begin_control(%param,
                        command  => 'tag'
                       );
-    my ($debug,$transcript) =
-       @info{qw(debug transcript)};
+    my $transcript = $info{transcript};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my @tags = make_list($param{tag});
     if (not @tags and ($param{remove} or $param{add})) {
        if ($param{remove}) {
@@ -648,11 +644,9 @@ sub set_tag {
        my $action = 'Did not alter tags';
        my %tag_added = ();
        my %tag_removed = ();
-       my %fixed_removed = ();
        my @old_tags = split /\,?\s+/, $data->{keywords};
        my %tags;
        @tags{@old_tags} = (1) x @old_tags;
-       my $reopened = 0;
        my $old_data = dclone($data);
        if (not $param{add} and not $param{remove}) {
            $tag_removed{$_} = 1 for @old_tags;
@@ -772,10 +766,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) {
@@ -877,10 +869,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}) {
@@ -940,7 +930,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
@@ -1099,7 +1088,6 @@ sub set_submitter {
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     # here we only concern ourselves with the first of the merged bugs
     for my $data ($data[0]) {
@@ -1115,7 +1103,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 {
@@ -1214,7 +1202,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);
@@ -1230,7 +1217,7 @@ sub set_forwarded {
                $action= "Unset $config{bug} forwarded-to-address";
            }
            elsif (defined $data->{forwarded} and length($data->{forwarded})) {
-               $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
+               $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
            }
            else {
                $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
@@ -1303,7 +1290,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);
@@ -1315,7 +1301,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}'.";
            }
@@ -1398,7 +1384,6 @@ sub set_package {
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     # clean up the new package
     my $new_package =
        join(',',
@@ -1522,7 +1507,6 @@ sub set_found {
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %versions;
     for my $version (make_list($param{found})) {
        next unless defined $version;
@@ -1578,7 +1562,11 @@ sub set_found {
                if (not @svers) {
                    @svers = $version;
                }
-               else {
+               elsif (not grep {$version eq $_} @svers) {
+                    # The $version was not equal to one of the source
+                    # versions, so it's probably unqualified (or just
+                    # wrong). Delete it, and use the source versions
+                    # instead.
                    if (exists $found_versions{$version}) {
                        delete $found_versions{$version};
                        $found_removed{$version} = 1;
@@ -1591,7 +1579,7 @@ sub set_found {
                    }
                    # if the found we are adding matches any fixed
                    # versions, remove them
-                   my @temp = grep m{(^|/)\Q$sver\E}, keys %fixed_versions;
+                   my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
                    delete $fixed_versions{$_} for @temp;
                    $fixed_removed{$_} = 1 for @temp;
                }
@@ -1615,7 +1603,7 @@ sub set_found {
                # in the case of removal, we only concern ourself with
                # the version passed, not the source version it maps
                # to
-               my @temp = grep m{(^|/)\Q$version\E}, keys %found_versions;
+               my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
                delete $found_versions{$_} for @temp;
                $found_removed{$_} = 1 for @temp;
            }
@@ -1738,7 +1726,6 @@ sub set_fixed {
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %versions;
     for my $version (make_list($param{fixed})) {
        next unless defined $version;
@@ -1965,7 +1952,6 @@ sub set_merged {
        return;
     }
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my %data;
     my %merged_bugs;
     for my $data (@data) {
@@ -1976,7 +1962,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";
@@ -2010,9 +1995,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,
@@ -2104,7 +2086,6 @@ sub set_merged {
                    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};
@@ -2319,6 +2300,17 @@ sub __calculate_merge_status{
            @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
        }
     }
+    # if there is a non-source qualified version with a corresponding
+    # source qualified version, we only want to merge the source
+    # qualified version(s)
+    for (qw(fixed found)) {
+       my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}};
+       for my $unqualified_version (@unqualified_versions) {
+           if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) {
+               delete $merge_status{"${_}_versions"}{$unqualified_version};
+           }
+       }
+    }
     return (\%merge_status,$bugs_to_merge);
 }
 
@@ -2544,7 +2536,6 @@ sub affects {
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
     my @data = @{$info{data}};
-    my @bugs = @{$info{bugs}};
     my $action = '';
     for my $data (@data) {
        $action = '';
@@ -2647,7 +2638,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.
@@ -2722,7 +2713,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 = '';
@@ -2732,10 +2722,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;
         }
@@ -2769,7 +2759,7 @@ sub _summary {
              }
              # skip a paragraph if it looks like it's control or
              # pseudo-headers
-             if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+             if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
                  $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
                                 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
                                 debug|(?:not|)forwarded|priority|
@@ -2878,10 +2868,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) {
@@ -2947,19 +2935,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),
@@ -3013,7 +3003,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";
@@ -3226,7 +3215,6 @@ sub bug_unarchive {
                                command=>'unarchive');
      my ($debug,$transcript) =
         @info{qw(debug transcript)};
-     my @data = @{$info{data}};
      my @bugs = @{$info{bugs}};
      my $action = "$config{bug} unarchived.";
      my @files_to_remove;
@@ -3422,25 +3410,25 @@ sub append_action_to_log{
      }
      my $msg = join('',
                    (exists $param{command} ?
-                    "<!-- command:".html_escape(encode_utf8($param{command}))." -->\n":""
+                    "<!-- command:".html_escape(encode_utf8_safely($param{command}))." -->\n":""
                    ),
                    (length $param{requester} ?
-                    "<!-- requester: ".html_escape(encode_utf8($param{requester}))." -->\n":""
+                    "<!-- requester: ".html_escape(encode_utf8_safely($param{requester}))." -->\n":""
                    ),
                    (length $param{request_addr} ?
-                    "<!-- request_addr: ".html_escape(encode_utf8($param{request_addr}))." -->\n":""
+                    "<!-- request_addr: ".html_escape(encode_utf8_safely($param{request_addr}))." -->\n":""
                    ),
                    "<!-- time:".time()." -->\n",
                    $data_diff,
-                   "<strong>".html_escape(encode_utf8($param{action}))."</strong>\n");
+                   "<strong>".html_escape(encode_utf8_safely($param{action}))."</strong>\n");
      if (length $param{requester}) {
-          $msg .= "Request was from <code>".html_escape(encode_utf8($param{requester}))."</code>\n";
+          $msg .= "Request was from <code>".html_escape(encode_utf8_safely($param{requester}))."</code>\n";
      }
      if (length $param{request_addr}) {
-          $msg .= "to <code>".html_escape(encode_utf8($param{request_addr}))."</code>";
+          $msg .= "to <code>".html_escape(encode_utf8_safely($param{request_addr}))."</code>";
      }
      if (length $param{desc}) {
-         $msg .= ":<br>\n".encode_utf8($param{desc})."\n";
+         $msg .= ":<br>\n".encode_utf8_safely($param{desc})."\n";
      }
      else {
          $msg .= ".\n";
@@ -3451,7 +3439,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})),
                        };
      }
@@ -3575,13 +3563,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!";
@@ -3803,7 +3792,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";
            }
@@ -3846,7 +3835,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,
                                                        );