use warnings;
use strict;
+
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
use base qw(Exporter);
%EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
qw(isstrongseverity bug_presence),
],
- read => [qw(readbug read_bug lockreadbug lockreadbugmerge)],
+ read => [qw(readbug read_bug lockreadbug lockreadbugmerge),
+ qw(lock_read_all_merged_bugs),
+ ],
write => [qw(writebug makestatus unlockwritebug)],
versions => [qw(addfoundversions addfixedversions),
qw(removefoundversions removefixedversions)
],
hook => [qw(bughook bughook_archive)],
+ fields => [qw(%fields)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(status read write versions hook));
+ Exporter::export_ok_tags(qw(status read write versions hook fields));
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
=cut
-
-my %fields = (originator => 'submitter',
+# these probably shouldn't be imported by most people, but
+# Debbugs::Control needs them, so they're now exportable
+our %fields = (originator => 'submitter',
date => 'date',
subject => 'subject',
msgid => 'message-id',
blocks => 'blocks',
blockedby => 'blocked-by',
unarchived => 'unarchived',
+ summary => 'summary',
+ affects => 'affects',
);
# Fields which need to be RFC1522-decoded in format versions earlier than 3.
=item summary -- complete path to the .summary file which will be read
+=item lock -- whether to obtain a lock for the bug to prevent
+something modifying it while the bug has been read. You B<must> call
+C<unfilelock();> if something not undef is returned from read_bug.
+
=back
One of C<bug> or C<summary> must be passed. This function will return
summary => {type => SCALAR,
optional => 1,
},
+ lock => {type => BOOLEAN,
+ optional => 1,
+ },
},
);
die "One of bug or summary must be passed to read_bug"
$status = getbugcomponent($lref, 'summary', $location);
$log = getbugcomponent($lref, 'log' , $location);
return undef unless defined $status;
+ return undef if not -e $status;
}
else {
$status = $param{summary};
$log =~ s/\.summary$/.log/;
($location) = $status =~ m/(db-h|db|archive)/;
}
- my $status_fh = new IO::File $status, 'r' or
- warn "Unable to open $status for reading: $!" and return undef;
+ if ($param{lock}) {
+ filelock("$config{spool_dir}/lock/$param{bug}");
+ }
+ my $status_fh = IO::File->new($status, 'r');
+ if (not defined $status_fh) {
+ warn "Unable to open $status for reading: $!";
+ if ($param{lock}) {
+ unfilelock();
+ }
+ return undef;
+ }
my %data;
my @lines;
}
# Version 3 is the latest format version currently supported.
- return undef if $version > 3;
+ if ($version > 3) {
+ warn "Unsupported status version '$version'";
+ if ($param{lock}) {
+ unfilelock();
+ }
+ return undef;
+ }
my %namemap = reverse %fields;
for my $line (@lines) {
# Add log last modified time
$data{log_modified} = (stat($log))[9];
$data{location} = $location;
+ $data{archived} = (defined($location) and ($location eq 'archive'))?1:0;
+ $data{bug_num} = $param{bug};
return \%data;
}
sub lockreadbug {
my ($lref, $location) = @_;
- &filelock("lock/$lref");
- my $data = read_bug(bug => $lref, location => $location);
- &unfilelock unless defined $data;
- return $data;
+ return read_bug(bug => $lref, location => $location, lock => 1);
}
=head2 lockreadbugmerge
return (1,$data);
}
unfilelock();
- filelock('lock/merge');
+ filelock("$config{spool_dir}/lock/merge");
$data = lockreadbug(@_);
if (not defined $data) {
unfilelock();
return (2,$data);
}
+=head2 lock_read_all_merged_bugs
+
+ my ($locks,@bug_data) = lock_read_all_merged_bugs($bug_num,$location);
+
+Performs a filelock, then reads the bug passed. If the bug is merged,
+locks the merge lock, then reads and locks all of the other merged
+bugs. Returns a list of the number of locks and the bug data for all
+of the merged bugs.
+
+Will also return undef if any of the merged bugs failed to be read,
+even if all of the others were read properly.
+
+=cut
+
+sub lock_read_all_merged_bugs {
+ my ($bug_num,$location) = @_;
+ my $locks = 0;
+ my @data = (lockreadbug(@_));
+ if (not @data or not defined $data[0]) {
+ return ($locks,undef);
+ }
+ $locks++;
+ if (not length $data[0]->{mergedwith}) {
+ return ($locks,@data);
+ }
+ unfilelock();
+ $locks--;
+ filelock("$config{spool_dir}/lock/merge");
+ $locks++;
+ @data = (lockreadbug(@_));
+ if (not @data or not defined $data[0]) {
+ unfilelock(); #for merge lock above
+ $locks--;
+ return ($locks,undef);
+ }
+ $locks++;
+ my @bugs = split / /, $data[0]->{mergedwith};
+ for my $bug (@bugs) {
+ my $newdata = undef;
+ if ($bug ne $bug_num) {
+ $newdata = lockreadbug($bug,$location);
+ if (not defined $newdata) {
+ for (1..$locks) {
+ unfilelock();
+ }
+ $locks = 0;
+ warn "Unable to read bug: $bug while handling merged bug: $bug_num";
+ return ($locks,undef);
+ }
+ $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();
+ }
+ die "Bug $bug_num differs from bug $bug: ($newdata->{bug_num}: $newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
+ }
+ }
+ return ($locks,@data);
+}
+
my @v1fieldorder = qw(originator date subject msgid package
keywords done forwarded mergedwith severity);
for my $version (keys %outputs) {
next if defined $minversion and $version < $minversion;
my $status = getbugcomponent($ref, $outputs{$version}, $location);
- &quit("can't find location for $ref") unless defined $status;
- open(S,"> $status.new") || &quit("opening $status.new: $!");
+ die "can't find location for $ref" unless defined $status;
+ open(S,"> $status.new") || die "opening $status.new: $!";
print(S makestatus($data, $version)) ||
- &quit("writing $status.new: $!");
- close(S) || &quit("closing $status.new: $!");
+ die "writing $status.new: $!";
+ close(S) || die "closing $status.new: $!";
if (-e $status) {
$change = 'change';
} else {
$change = 'new';
}
- rename("$status.new",$status) || &quit("installing new $status: $!");
+ rename("$status.new",$status) || die "installing new $status: $!";
}
# $disablebughook is a bit of a hack to let format migration scripts use
my $version = shift;
my $isbinary = shift;
return unless defined $version;
- undef $package if $package =~ m[(?:\s|/)];
- my $source = $package;
-
- if (defined $package and $isbinary) {
- my @srcinfo = binarytosource($package, $version, undef);
- if (@srcinfo) {
- # We know the source package(s). Use a fully-qualified version.
- removefixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
- return;
- }
- # Otherwise, an unqualified version will have to do.
- undef $source;
- }
foreach my $ver (split /[,\s]+/, $version) {
- my $sver = defined($source) ? "$source/$ver" : '';
- @{$data->{fixed_versions}} =
- grep { $_ ne $ver and $_ ne $sver } @{$data->{fixed_versions}};
+ if ($ver =~ m{/}) {
+ # fully qualified version
+ @{$data->{fixed_versions}} =
+ grep {$_ ne $ver}
+ @{$data->{fixed_versions}};
+ }
+ else {
+ # non qualified version; delete all matchers
+ @{$data->{fixed_versions}} =
+ grep {$_ !~ m[(?:^|/)\Q$ver\E$]}
+ @{$data->{fixed_versions}};
+ }
}
}
my $status = $param{status};
if (not exists $param{status} or not defined $status) {
$status = read_bug(bug=>$param{bug});
- return undef if not defined $status;
+ if (not defined $status) {
+ print STDERR "Cannot archive $param{bug} because it does not exist\n" if $DEBUG;
+ return undef;
+ }
}
# Bugs can be archived if they are
# 1. Closed
- return $cannot_archive if not defined $status->{done} or not length $status->{done};
+ if (not defined $status->{done} or not length $status->{done}) {
+ print STDERR "Cannot archive $param{bug} because it is not done\n" if $DEBUG;
+ return $cannot_archive
+ }
+ # 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}||'')) {
+ 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;
+ }
+ }
+ }
+
# If we just are checking if the bug can be archived, we'll not even bother
# checking the versioning information if the bug has been -done for less than 28 days.
my $log_file = getbugcomponent($param{bug},'log');
last if $buggy eq 'found';
$min_fixed_time = min($time_versions{$version},$min_fixed_time);
}
- $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24)));
+ $min_archive_days = max($min_archive_days,ceil($config{remove_age} - (time - $min_fixed_time)/(60*60*24)))
+ # if there are no versions in the archive at all, then
+ # we can archive if enough days have passed
+ if @sourceversions;
}
# If $param{ignore_time}, then we should ignore time.
if ($param{ignore_time}) {
# 6. at least 28 days have passed since the last action has occured or the bug was closed
my $age = ceil($max_log_age);
if ($age > 0 or $min_archive_days > 0) {
+ print STDERR "Cannot archive $param{bug} because not enough days have passed\n" if $DEBUG;
return $param{days_until}?max($age,$min_archive_days):0;
}
else {
dist, arch, and version. [The entries in this array must be in the
"source/version" format.] Eventually this can be used to for caching.
+=item indicatesource -- if true, indicate which source packages this
+bug could belong to (or does belong to in the case of bugs assigned to
+a source package). Defaults to true.
+
=back
Note: Currently the version information is cached; this needs to be
sourceversions => {type => ARRAYREF,
optional => 1,
},
+ indicatesource => {type => BOOLEAN,
+ default => 1,
+ },
},
);
my %status;
$status{tags} = $status{keywords};
my %tags = map { $_ => 1 } split ' ', $status{tags};
+ $status{package} = '' if not defined $status{package};
$status{"package"} =~ s/\s*$//;
+ # if we aren't supposed to indicate the source, we'll return
+ # unknown here.
+ $status{source} = 'unknown';
+ if ($param{indicatesource}) {
+ my @packages = split /\s*,\s*/, $status{package};
+ my @source;
+ for my $package (@packages) {
+ next if $package eq '';
+ if ($package =~ /^src\:$/) {
+ push @source,$1;
+ }
+ else {
+ push @source, binarytosource($package);
+ }
+ }
+ if (@source) {
+ $status{source} = join(', ',@source);
+ }
+ }
+
$status{"package"} = 'unknown' if ($status{"package"} eq '');
- $status{"severity"} = 'normal' if ($status{"severity"} eq '');
+ $status{"severity"} = 'normal' if (not defined $status{severity} or $status{"severity"} eq '');
$status{"pending"} = 'pending';
$status{"pending"} = 'forwarded' if (length($status{"forwarded"}));
$status{"pending"} = 'fixed' if ($tags{fixed});
- my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()}
+ my $presence = bug_presence(status => \%status,
+ map{(exists $param{$_})?($_,$param{$_}):()}
qw(bug sourceversions arch dist version found fixed package)
);
if (defined $presence) {
}
}
} elsif (defined $param{dist}) {
+ my %affects_distribution_tags;
+ @affects_distribution_tags{@{$config{affects_distribution_tags}}} =
+ (1) x @{$config{affects_distribution_tags}};
+ my $some_distributions_disallowed = 0;
+ my %allowed_distributions;
+ for my $tag (split ' ', ($status{tags}||'')) {
+ if (exists $config{distribution_aliases}{$tag} and
+ exists $affects_distribution_tags{$config{distribution_aliases}{$tag}}) {
+ $some_distributions_disallowed = 1;
+ $allowed_distributions{$config{distribution_aliases}{$tag}} = 1;
+ }
+ elsif (exists $affects_distribution_tags{$tag}) {
+ $some_distributions_disallowed = 1;
+ $allowed_distributions{$tag} = 1;
+ }
+ }
foreach my $arch (make_list($param{arch})) {
- my @versions;
for my $package (split /\s*,\s*/, $status{package}) {
+ my @versions;
foreach my $dist (make_list($param{dist})) {
+ # if some distributions are disallowed,
+ # and this isn't an allowed
+ # distribution, then we ignore this
+ # distribution for the purposees of
+ # finding versions
+ if ($some_distributions_disallowed and
+ not exists $allowed_distributions{$dist}) {
+ next;
+ }
push @versions, getversions($package, $dist, $arch);
}
+ next unless @versions;
my @temp = makesourceversions($package,
$arch,
@versions
my $maxbuggy = 'undef';
if (@sourceversions) {
$maxbuggy = max_buggy(bug => $param{bug},
- sourceversions => \@sourceversions,
- found => $status{found_versions},
- fixed => $status{fixed_versions},
- package => $status{package},
- version_cache => $version_cache,
- );
+ sourceversions => \@sourceversions,
+ found => $status{found_versions},
+ fixed => $status{fixed_versions},
+ package => $status{package},
+ version_cache => $version_cache,
+ );
}
elsif (defined $param{dist} and
not exists $pseudo_desc->{$status{package}}) {
sub bughook_archive {
my @refs = @_;
- &filelock("debbugs.trace.lock");
+ &filelock("$config{spool_dir}/debbugs.trace.lock");
&appendfile("debbugs.trace","archive ".join(',',@refs)."\n");
my %bugs = update_realtime("$config{spool_dir}/index.db.realtime",
map{($_,'REMOVE')} @refs);
sub bughook {
my ( $type, %bugs_temp ) = @_;
- &filelock("debbugs.trace.lock");
+ &filelock("$config{spool_dir}/debbugs.trace.lock");
my %bugs;
for my $bug (keys %bugs_temp) {