return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0]
if exists $_parsedaddrs{$addr};
{
- no warnings;
+ # don't display the warnings from Mail::Address->parse
+ local $SIG{__WARN__} = sub { };
@{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
}
return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0];
qw($gSendmail $gLibPath $gSpamScan @gExcludeFromControl),
qw(%gSeverityDisplay @gTags @gSeverityList @gStrongSeverities),
qw(%gSearchEstraier),
+ qw(%gDistributionAliases),
qw(@gPostProcessall @gRemovalDefaultDistributionTags @gRemovalDistributionTags @gRemovalArchitectures),
+ qw(@gRemovalStrongSeverityDefaultDistributionTags),
],
text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote),
],
set_default(\%config,'save_old_bugs',1);
+=item distribution_aliases
+
+Map of distribution aliases to the distribution name
+
+Default:
+ {experimental => 'experimental',
+ unstable => 'unstable',
+ testing => 'testing',
+ stable => 'stable',
+ oldstable => 'oldstable',
+ sid => 'unstable',
+ lenny => 'testing',
+ etch => 'stable',
+ sarge => 'oldstable',
+ }
+
+=cut
+
+set_default(\%config,'distribution_aliases',
+ {experimental => 'experimental',
+ unstable => 'unstable',
+ testing => 'testing',
+ stable => 'stable',
+ oldstable => 'oldstable',
+ sid => 'unstable',
+ lenny => 'testing',
+ etch => 'stable',
+ sarge => 'oldstable',
+ },
+ );
+
+
+
=item distributions
List of valid distributions
-Default: qw(experimental unstable testing stable oldstable);
+Default: The values of the distribution aliases map.
=cut
-set_default(\%config,'distributions',[qw(experimental unstable testing stable oldstable)]);
+my %_distributions_default;
+@_distributions_default{values %{$config{distribution_aliases}}} = values %{$config{distribution_aliases}};
+set_default(\%config,'distributions',[keys %_distributions_default]);
=item removal_distribution_tags
[qw(unstable testing)]
);
+=item removal_strong_severity_default_distribution_tags
+
+For removal/archival purposes, all bugs with strong severity are
+assumed to have these tags set.
+
+Default: qw(unstable testing stable);
+
+=cut
+
+set_default(\%config,'removal_strong_severity_default_distribution_tags',
+ [qw(unstable testing stable)]
+ );
+
+
=item removal_architectures
For removal/archival purposes, these architectures are consulted if
use File::Path qw(mkpath);
use IO::File;
+use POSIX qw(strftime);
+
# These are a set of options which are common to all of these functions
my %common_options = (debug => {type => SCALARREF,
%append_action_options,
},
);
+ our $locks = 0;
+ local $SIG{__DIE__} = sub {
+ if ($locks) {
+ for (1..$locks) { unfilelock(); }
+ $locks = 0;
+ }
+ };
my $action = "$config{bug} archived.";
my ($debug,$transcript) = __handle_debug_transcript(%param);
if ($param{check_archiveable} and
die "Bug $param{bug} cannot be archived";
}
print {$debug} "$param{bug} considering\n";
- my ($locks, $data) = lockreadbugmerge($param{bug});
+ my ($data);
+ ($locks, $data) = lockreadbugmerge($param{bug});
print {$debug} "$param{bug} read $locks\n";
defined $data or die "No bug found for $param{bug}";
print {$debug} "$param{bug} read ok (done $data->{done})\n";
}
if (not exists $param{message}) {
$action = $param{action} if exists $param{action};
+ my $date = strftime "%a, %d %h %Y %T +0000", gmtime;
$param{message} = <<END;
Received: (at fakecontrol) by fakecontrolmessage;
To: $param{request_addr}
From: $param{requester}
Subject: Internal Control
Message-Id: $action
+Date: $date
User-Agent: Fakemail v42.6.9
# A New Hope
sub get_versions{
my %param = validate_with(params => \@_,
- spec => {package => {type => SCALAR,
+ spec => {package => {type => SCALAR|ARRAYREF,
},
dist => {type => SCALAR|ARRAYREF,
default => 'unstable',
=head2 get_bugs
my @bugs = get_bugs(...);
+ my @bugs = get_bugs([...]);
-Returns a list of bugs.
+Returns a list of bugs. In the second case, allows the variable
+parameters to be specified as an array reference in case your favorite
+language's SOAP implementation is craptacular.
-See L<Debbugs::Bugs::get_bugs> for details.
+See L<Debbugs::Bugs::get_bugs> for details on what C<...> actually
+means.
=cut
sub get_bugs{
my $VERSION = __populate_version(pop);
my ($self,@params) = @_;
+ # Because some soap implementations suck and can't handle
+ # variable numbers of arguments we allow get_bugs([]);
+ if (@params == 1 and ref($params[0]) eq 'ARRAY') {
+ @params = @{$params[0]};
+ }
my %params;
# Because some clients can't handle passing arrayrefs, we allow
# options to be specified multiple times
]
+Currently $msg_num is completely ignored.
+
=cut
use Debbugs::Log qw();
use Debbugs::MIME qw(parse);
sub get_bug_log{
+ my $VERSION = __populate_version(pop);
my ($self,$bug,$msg_num) = @_;
my $location = getbuglocation($bug,'log');
# checking the versioning information if the bug has been -done for less than 28 days.
my $log_file = getbugcomponent($param{bug},'log');
if (not defined $log_file) {
- print STDERR "Cannot archive $param{bug} because the log doesn't exists\n" if $DEBUG;
+ print STDERR "Cannot archive $param{bug} because the log doesn't exist\n" if $DEBUG;
+ return $cannot_archive;
}
+ my $max_log_age = max(map {$config{remove_age} - -M $_}
+ $log_file, map {my $log = getbugcomponent($_,'log');
+ defined $log ? ($log) : ();
+ }
+ split / /, $status->{mergedwith}
+ );
if (not $param{days_until} and not $param{ignore_time}
- and $config{remove_age} >
- -M $log_file
+ and $max_log_age > 0
) {
print STDERR "Cannot archive $param{bug} because of time\n" if $DEBUG;
return $cannot_archive;
# tags set, we assume a default set, otherwise we use the tags the bug
# has set.
+ # In cases where we are assuming a default set, if the severity
+ # is strong, we use the strong severity default; otherwise, we
+ # use the normal default.
+
# There must be fixed_versions for us to look at the versioning
# information
my $min_fixed_time = time;
@dist_tags{@{$config{removal_distribution_tags}}} =
(1) x @{$config{removal_distribution_tags}};
my %dists;
- @dists{@{$config{removal_default_distribution_tags}}} =
- (1) x @{$config{removal_default_distribution_tags}};
for my $tag (split ' ', ($status->{tags}||'')) {
- next unless $dist_tags{$tag};
- $dists{$tag} = 1;
+ next unless exists $config{distribution_aliases}{$tag};
+ next unless $dist_tags{$config{distribution_aliases}{$tag}};
+ $dists{$config{distribution_aliases}{$tag}} = 1;
+ }
+ if (not keys %dists) {
+ if (isstrongseverity($status->{severity})) {
+ @dists{@{$config{removal_strong_severity_default_distribution_tags}}} =
+ (1) x @{$config{removal_strong_severity_default_distribution_tags}};
+ }
+ else {
+ @dists{@{$config{removal_default_distribution_tags}}} =
+ (1) x @{$config{removal_default_distribution_tags}};
+ }
}
my %source_versions;
my @sourceversions = get_versions(package => $status->{package},
return $param{days_until}?0:1;
}
# 6. at least 28 days have passed since the last action has occured or the bug was closed
- my $age = ceil(max(map {$config{remove_age} - -M $log_file}
- $param{bug}, split / /, $status->{mergedwith}
- )
- );
+ my $age = ceil($max_log_age);
if ($age > 0 or $min_archive_days > 0) {
return $param{days_until}?max($age,$min_archive_days):0;
}
# We only want to warn if it's a package which actually has a maintainer
my $maints = getmaintainers();
next if not exists $maints->{$source};
- warn "Unable to open $config{version_packages_dir}/$srchash/$source: $!";
+ warn "Bug $param{bug}: unable to open $config{version_packages_dir}/$srchash/$source: $!";
next;
}
$version->load($version_fh);
}
if (defined $param{usertag}) {
- my %select_ut = ();
- my ($u, $t) = split /:/, $param{usertag}, 2;
- Debbugs::User::read_usertags(\%select_ut, $u);
- unless (defined $t && $t ne "") {
- $t = join(",", keys(%select_ut));
- }
-
- add_user($u);
- push @{$param{tag}}, split /,/, $t;
+ for my $usertag (make_list($param{usertag})) {
+ my %select_ut = ();
+ my ($u, $t) = split /:/, $usertag, 2;
+ Debbugs::User::read_usertags(\%select_ut, $u);
+ unless (defined $t && $t ne "") {
+ $t = join(",", keys(%select_ut));
+ }
+ add_user($u);
+ push @{$param{tag}}, split /,/, $t;
+ }
}
my $Archived = $archive ? " Archived" : "";
@title = ();
# we have to special case the maint="" search, unfortunatly.
-if (defined $param{maint} and $param{maint} eq "") {
+if (defined $param{maint} and $param{maint} eq "" or ref($param{maint}) and not @{$param{maint}}) {
my %maintainers = %{getmaintainers()};
@bugs = get_bugs(function =>
sub {my %d=@_;
use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters munge_url);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
-use Debbugs::Packages qw(getversions makesourceversions);
+use Debbugs::Packages qw(get_versions makesourceversions);
use HTML::Entities qw(encode_entities);
use File::Temp qw(tempdir);
use IO::File;
my %versions;
my %version_to_dist;
for my $dist (@{$config{distributions}}) {
- $versions{$dist} = [getversions($cgi_var{package},$dist)];
+ $versions{$dist} = [get_versions(package => [split /\s*,\s*/, $cgi_var{package}],
+ dist => $dist,
+ source => 1,
+ )];
# make version_to_dist
foreach my $version (@{$versions{$dist}}){
push @{$version_to_dist{$version}}, $dist;
# turn found and fixed into full versions
@{$cgi_var{found}} = map {makesourceversions($_,undef,@{$cgi_var{found}})} split/\s*,\s*/, $cgi_var{package};
@{$cgi_var{fixed}} = map {makesourceversions($_,undef,@{$cgi_var{fixed}})} split/\s*,\s*/, $cgi_var{package};
-my @interesting_versions = makesourceversions($cgi_var{package},undef,keys %version_to_dist);
+my @interesting_versions = map {makesourceversions($_,undef,keys %version_to_dist)} split/\s*,\s*/, $cgi_var{package};
# We need to be able to rip out leaves which the versions that do not affect the current versions of unstable/testing
my %sources;
print "Content-Type: text/html\n\n";
print "<HTML><HEAD><TITLE>Verify submission</TITLE></HEAD><BODY>\n";
print "<H2>Verify report for bug $bug</H2>\n";
- print qq(<A HREF="bugspam.cgi?bug=$bug;ok=ok">Yes, report bug $bug as spam</A>\n);
+ print qq(<A HREF="bugspam.cgi?bug=$bug;ok=ok">Yes, report that bug $bug has spam</A>\n);
print "</BODY></HTML>\n";
exit 0;
}
my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
+ $action = "$gBug marked as found in version $version and reopened."
+ if length $data->{done};
$data->{done} = '';
- $action = "$gBug marked as found in version $version and reopened.";
}
} else {
# Versionless found; assume old-style "not fixed at
projects / debbugs.git / commitdiff