From be4f44cfbf65f509a237926f168fe6ffc19ccf96 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Wed, 13 Jun 2007 15:30:12 +0100 Subject: [PATCH] * Add Debbugs::Control which will eventually contain most of the control actions which are currently stuck in service.in * Add bug_archive and bug_unarchive routines which are called by service.in and expire.in as appropriate * Change expire.in to use bug_archive * Test archival and unarchival in 06_mail_handling.t * Document archive and unarchive control commands * Add control_request* configuration variables for the fake messages appended to the log when bugs are archived/unarchived internally. * Move escape_log to Debbugs::Log and rename it * Change all usages of escapelog to escape_log; escape_log now returns a list instead of pointlessly using an ARRAYREF. * No longer export things by default from Debbugs::Log * Move logreadbugmerge to Debbugs::Status where it should have been originally * Use append_action_to_log in Debbugs::Control (possibly should be in Debbugs::Log) instead of duplicating it everywhere. [It's still duplicated in service.in's -1.log, but sue me.] --- Debbugs/Common.pm | 2 +- Debbugs/Config.pm | 26 ++ Debbugs/Control.pm | 492 ++++++++++++++++++++++++++++++++++++ Debbugs/Log.pm | 45 +++- Debbugs/Status.pm | 50 +++- html/server-control.html.in | 12 + scripts/errorlib.in | 11 - scripts/expire.in | 105 +++----- scripts/process.in | 6 +- scripts/service.in | 71 +++++- t/06_mail_handling.t | 30 ++- 11 files changed, 732 insertions(+), 118 deletions(-) create mode 100644 Debbugs/Control.pm diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index 457c7ad..9776392 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -189,7 +189,7 @@ sub appendfile { =head2 getparsedaddrs my $address = getparsedaddrs($address); - my @address = getpasredaddrs($address); + my @address = getparsedaddrs($address); Returns the output from Mail::Address->parse, or the cached output if this address has been parsed before. In SCALAR context returns the diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm index 6b8639f..c9e17dc 100644 --- a/Debbugs/Config.pm +++ b/Debbugs/Config.pm @@ -395,6 +395,32 @@ set_default(\%config,'package_version_re', '[A-Za-z0-9:+\.~-]+'); +=item control_internal_requester + +This address is used by Debbugs::Control as the request address which +sent a control request for faked log messages. + +Default:"Debbugs Internal Request <$config{maintainer_email}>" + +=cut + +set_default(\%config,'control_internal_requester', + "Debbugs Internal Request <$config{maintainer_email}>", + ); + +=item control_internal_request_addr + +This address is used by Debbugs::Control as the address to which a +faked log message request was sent. + +Default: "internal_control\@$config{email_domain}"; + +=cut + +set_default(\%config,'control_internal_request_addr', + 'internal_control@'.$config{email_domain}, + ); + =item exclude_from_control diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm new file mode 100644 index 0000000..1003e9c --- /dev/null +++ b/Debbugs/Control.pm @@ -0,0 +1,492 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later +# version at your option. +# See the file README and COPYING for more information. +# +# [Other people have contributed to this file; their copyrights should +# go here too.] +# Copyright 2007 by Don Armstrong . + +package Debbugs::Control; + +=head1 NAME + +Debbugs::Control -- Routines for modifying the state of bugs + +=head1 SYNOPSIS + +use Debbugs::Control; + + +=head1 DESCRIPTION + +This module is an abstraction of a lot of functions which originally +were only present in service.in, but as time has gone on needed to be +called from elsewhere. + +All of the public functions take the following options: + +=over + +=item debug -- scalar reference to which debbuging information is +appended + +=item transcript -- scalar reference to which transcript information +is appended + +=item affected_bugs -- hashref which is updated with bugs affected by +this function + + +=back + +Functions which should (probably) append to the .log file take the +following options: + +=over + +=item requester -- Email address of the individual who requested the change + +=item request_addr -- Address to which the request was sent + +=item location -- Optional location; currently ignored but may be +supported in the future for updating archived bugs upon archival + +=item message -- The original message which caused the action to be taken + +=item append_log -- Whether or not to append information to the log. + +=back + +B (for most functions) is a special option. When set to +false, no appending to the log is done at all. When it is not present, +the above information is faked, and appended to the log file. When it +is true, the above options must be present, and their values are used. + + +=head1 FUNCTIONS + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +BEGIN{ + $VERSION = 1.00; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (archive => [qw(bug_archive bug_unarchive), + ], + log => [qw(append_action_to_log), + ], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(qw(archive log)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + +use Debbugs::Config qw(:config); +use Debbugs::Common qw(:lock buglog make_list get_hashname); +use Debbugs::Status qw(bug_archiveable :read :hook); +use Debbugs::CGI qw(html_escape); +use Debbugs::Log qw(:misc); + +use Params::Validate qw(validate_with :types); +use File::Path qw(mkpath); +use IO::File; + +# These are a set of options which are common to all of these functions + +my %common_options = (debug => {type => SCALARREF, + optional => 1, + }, + transcript => {type => SCALARREF, + optional => 1, + }, + affected_bugs => {type => HASHREF, + optional => 1, + }, + ); + + +my %append_action_options = + (action => {type => SCALAR, + optional => 1, + }, + requester => {type => SCALAR, + optional => 1, + }, + request_addr => {type => SCALAR, + optional => 1, + }, + location => {type => SCALAR, + optional => 1, + }, + message => {type => SCALAR|ARRAYREF, + optional => 1, + }, + append_log => {type => BOOLEAN, + optional => 1, + depends => [qw(requester request_addr), + qw(message), + ], + }, + ); + + +=head2 bug_archive + + my $error = ''; + eval { + bug_archive(bug => $bug_num, + debug => \$debug, + transcript => \$transcript, + ); + }; + if ($@) { + $errors++; + transcript("Unable to archive $bug_num\n"); + warn $@; + } + transcript($transcript); + + +This routine archives a bug + +=cut + +sub bug_archive { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+/, + }, + check_archiveable => {type => BOOLEAN, + default => 1, + }, + ignore_time => {type => BOOLEAN, + default => 0, + }, + %common_options, + %append_action_options, + }, + ); + my $action = "$config{bug} archived."; + my ($debug,$transcript) = __handle_debug_transcript(%param); + if ($param{check_archiveable} and + not bug_archiveable(bug=>$param{bug}, + ignore_time => $param{ignore_time}, + )) { + print {$transcript} "Bug $param{bug} cannot be archived\n"; + die "Bug $param{bug} cannot be archived"; + } + print {$debug} "$param{bug} considering\n"; + my ($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"; + print {$debug} "$param{bug} read done\n"; + my @bugs = ($param{bug}); + # my %bugs; + # @bugs{@bugs} = (1) x @bugs; + if (length($data->{mergedwith})) { + push(@bugs,split / /,$data->{mergedwith}); + } + print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; + for my $bug (@bugs) { + my $newdata; + print {$debug} "$param{bug} $bug check\n"; + if ($bug != $param{bug}) { + print {$debug} "$param{bug} $bug reading\n"; + $newdata = lockreadbug($bug) || die "huh $bug ?"; + print {$debug} "$param{bug} $bug read ok\n"; + $locks++; + } else { + $newdata = $data; + } + print {$debug} "$param{bug} $bug read/not\n"; + my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); + $newdata->{mergedwith} eq $expectmerge || + die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")"; + print {$debug} "$param{bug} $bug merge-ok\n"; + if ($param{check_archiveable}) { + die "Bug $bug cannot be archived (but $param{bug} can?)" + unless bug_archiveable(bug=>$bug, + ignore_time => $param{ignore_time}, + ); + } + } + # If we get here, we can archive/remove this bug + print {$debug} "$param{bug} removing\n"; + for my $bug (@bugs) { + #print "$param{bug} removing $bug\n" if $debug; + my $dir = get_hashname($bug); + # First indicate that this bug is being archived + append_action_to_log(bug => $bug, + get_lock => 0, + __return_append_to_log_options( + (map {exists $param{$_}?($_,$param{$_}):()} + keys %append_action_options, + ), + action => $action, + ) + ) + if not exists $param{append_log} or $param{append_log}; + my @files_to_remove = map {s#db-h/$dir/##; $_} glob("db-h/$dir/$bug.*"); + if ($config{save_old_bugs}) { + mkpath("archive/$dir"); + foreach my $file (@files_to_remove) { + link( "db-h/$dir/$file", "archive/$dir/$file" ) || copy( "db-h/$dir/$file", "archive/$dir/$file" ); + } + + print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n"; + } + unlink(map {"db-h/$dir/$_"} @files_to_remove); + print {$transcript} "deleted $bug (from $param{bug})\n"; + bughook_archive($bug); + } + if (exists $param{bugs_affected}) { + @{$param{bugs_affected}}{@bugs} = (1) x @bugs; + } + print {$debug} "$param{bug} unlocking $locks\n"; + if ($locks) { + for (1..$locks) { unfilelock(); } + } + print {$debug} "$param{bug} unlocking done\n"; +} + +=head2 bug_unarchive + + my $error = ''; + eval { + bug_unarchive(bug => $bug_num, + debug => \$debug, + transcript => \$transcript, + ); + }; + if ($@) { + $errors++; + transcript("Unable to archive bug: $bug_num"); + } + transcript($transcript); + +This routine unarchives a bug + +=cut + +sub bug_unarchive { + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+/, + }, + %common_options, + %append_action_options, + }, + ); + my $action = "$config{bug} unarchived."; + my ($debug,$transcript) = __handle_debug_transcript(%param); + print {$debug} "$param{bug} considering\n"; + my ($locks, $data) = lockreadbugmerge($param{bug},'archive'); + print {$debug} "$param{bug} read $locks\n"; + if (not defined $data) { + print {$transcript} "No bug found for $param{bug}\n"; + die "No bug found for $param{bug}"; + } + print {$debug} "$param{bug} read ok (done $data->{done})\n"; + print {$debug} "$param{bug} read done\n"; + my @bugs = ($param{bug}); + # my %bugs; + # @bugs{@bugs} = (1) x @bugs; + if (length($data->{mergedwith})) { + push(@bugs,split / /,$data->{mergedwith}); + } + print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n"; + for my $bug (@bugs) { + my $newdata; + print {$debug} "$param{bug} $bug check\n"; + if ($bug != $param{bug}) { + print {$debug} "$param{bug} $bug reading\n"; + $newdata = lockreadbug($bug,'archive') or die "huh $bug ?"; + print {$debug} "$param{bug} $bug read ok\n"; + $locks++; + } else { + $newdata = $data; + } + print {$debug} "$param{bug} $bug read/not\n"; + my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs)); + if ($newdata->{mergedwith} ne $expectmerge ) { + print {$transcript} "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)"; + die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)"; + } + print {$debug} "$param{bug} $bug merge-ok\n"; + } + # If we get here, we can archive/remove this bug + print {$debug} "$param{bug} removing\n"; + my @files_to_remove; + for my $bug (@bugs) { + print {$debug} "$param{bug} removing $bug\n"; + my $dir = get_hashname($bug); + my @files_to_copy = map {s#archive/$dir/##; $_} glob("archive/$dir/$bug.*"); + mkpath("archive/$dir"); + foreach my $file (@files_to_copy) { + # die'ing here sucks + link( "archive/$dir/$file", "db-h/$dir/$file" ) or + copy( "archive/$dir/$file", "db-h/$dir/$file" ) or + die "Unable to copy archive/$dir/$file to db-h/$dir/$file"; + } + push @files_to_remove, map {"archive/$dir/$_"} @files_to_copy; + print {$transcript} "Unarchived $config{bug} $bug\n"; + } + unlink(@files_to_remove) or die "Unable to unlink bugs"; + # Indicate that this bug has been archived previously + for my $bug (@bugs) { + my $newdata = readbug($bug); + if (not defined $newdata) { + print {$transcript} "$config{bug} $bug disappeared!\n"; + die "Bug $bug disappeared!"; + } + $newdata->{unarchived} = time; + append_action_to_log(bug => $bug, + get_lock => 0, + __return_append_to_log_options( + (map {exists $param{$_}?($_,$param{$_}):()} + keys %append_action_options, + ), + action => $action, + ) + ) + if not exists $param{append_log} or $param{append_log}; + writebug($bug,$newdata); + } + print {$debug} "$param{bug} unlocking $locks\n"; + if ($locks) { + for (1..$locks) { unfilelock(); }; + } + if (exists $param{bugs_affected}) { + @{$param{bugs_affected}}{@bugs} = (1) x @bugs; + } + print {$debug} "$param{bug} unlocking done\n"; +} + +=head2 append_action_to_log + + append_action_to_log + +This should probably be moved to Debbugs::Log; have to think that out +some more. + +=cut + +sub append_action_to_log{ + my %param = validate_with(params => \@_, + spec => {bug => {type => SCALAR, + regex => qr/^\d+/, + }, + action => {type => SCALAR, + }, + requester => {type => SCALAR, + }, + request_addr => {type => SCALAR, + }, + location => {type => SCALAR, + optional => 1, + }, + message => {type => SCALAR|ARRAYREF, + }, + get_lock => {type => BOOLEAN, + default => 1, + }, + } + ); + # Fix this to use $param{location} + my $log_location = buglog($param{bug}); + die "Unable to find .log for $param{bug}" + if not defined $log_location; + if ($param{get_lock}) { + filelock("lock/$param{bug}"); + } + my $log = IO::File->new(">>$log_location") or + die "Unable to open $log_location for appending: $!"; + print {$log} "\6\n". + "\n". + "".html_escape($param{action})."\n". + "Request was from ".html_escape($param{requester})."\n". + "to ".html_escape($param{request_addr}).". \n". + "\3\n". + "\7\n",escape_log(make_list($param{message})),"\n\3\n" + or die "Unable to append to $log_location: $!"; + close $log or die "Unable to close $log_location: $!"; + if ($param{get_lock}) { + unlockfile(); + } + + +} + + +=head1 PRIVATE FUNCTIONS + +=head2 __handle_debug_transcript + + my ($debug,$transcript) = __handle_debug_transcript(%param); + +Returns a debug and transcript IO::Scalar filehandle + + +=cut + +sub __handle_debug_transcript{ + my %param = validate_with(params => \@_, + spec => {%common_options}, + allow_extra => 1, + ); + my $fake_scalar; + my $debug = IO::Scalar->new(exists $param{debug}?$param{debug}:\$fake_scalar); + my $transcript = IO::Scalar->new(exists $param{transcript}?$param{transcript}:\$fake_scalar); + return ($debug,$transcript); + +} + +sub __return_append_to_log_options{ + my %param = @_; + my $action = 'Unknown action'; + if (not exists $param{requester}) { + $param{requester} = $config{control_internal_requester}; + } + if (not exists $param{request_addr}) { + $param{request_addr} = $config{control_internal_request_addr}; + } + if (not exists $param{message}) { + $action = $param{action} if exists $param{action}; + $param{message} = < $action, + %param); +} + + +1; + +__END__ diff --git a/Debbugs/Log.pm b/Debbugs/Log.pm index 5632f43..90abe9c 100644 --- a/Debbugs/Log.pm +++ b/Debbugs/Log.pm @@ -5,21 +5,34 @@ # # [Other people have contributed to this file; their copyrights should # go here too.] -# Copyright 2004 by Collin Waston +# Copyright 2004 by Collin Watson +# Copyright 2007 by Don Armstrong package Debbugs::Log; + +use warnings; use strict; -use Exporter (); -use vars qw($VERSION @ISA @EXPORT); +use vars qw($VERSION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS); +use base qw(Exporter); BEGIN { $VERSION = 1.00; - - @ISA = qw(Exporter); - @EXPORT = qw(read_log_records write_log_records); + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (write => [qw(write_log_records), + ], + read => [qw(read_log_records), + ], + misc => [qw(escape_log), + ], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(qw(write read misc)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; } =head1 NAME @@ -255,7 +268,7 @@ sub write_log_records (*@) for my $record (@records) { my $type = $record->{type}; - my $text = $record->{text}; + my ($text) = escapelog($record->{text}); die "type '$type' with no text field" unless defined $text; if ($type eq 'autocheck') { print $logfh "\01\n$text\03\n"; @@ -269,12 +282,12 @@ sub write_log_records (*@) } else { print $logfh "-t\n"; } - $text =~ s/^([\01-\07\030])/\030$1/gm; + #$text =~ s/^([\01-\07\030])/\030$1/gm; print $logfh "\05\n$text\03\n"; } elsif ($type eq 'html') { print $logfh "\06\n$text\03\n"; } elsif ($type eq 'incoming-recv') { - $text =~ s/^([\01-\07\030])/\030$1/gm; + #$text =~ s/^([\01-\07\030])/\030$1/gm; print $logfh "\07\n$text\03\n"; } else { die "unknown type '$type'"; @@ -284,6 +297,20 @@ sub write_log_records (*@) 1; } +=head2 escapelog + + print {$log} escapelog(@log) + +Applies the log escape regex to the passed logfile. + +=cut + +sub escape_log { + my @log = @_; + return map { s/^([\01-\07\030])/\030$1/gm; $_ } @log; +} + + =back =head1 CAVEATS diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm index 36cea42..5fb5413 100644 --- a/Debbugs/Status.pm +++ b/Debbugs/Status.pm @@ -55,7 +55,7 @@ BEGIN{ %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable), qw(isstrongseverity bug_presence), ], - read => [qw(readbug read_bug lockreadbug)], + read => [qw(readbug read_bug lockreadbug lockreadbugmerge)], write => [qw(writebug makestatus unlockwritebug)], versions => [qw(addfoundversions addfixedversions), qw(removefoundversions removefixedversions) @@ -96,6 +96,7 @@ my %fields = (originator => 'submitter', fixed_date => 'fixed-date', blocks => 'blocks', blockedby => 'blocked-by', + unarchived => 'unarchived', ); # Fields which need to be RFC1522-decoded in format versions earlier than 3. @@ -239,6 +240,36 @@ sub lockreadbug { return $data; } +=head2 lockreadbugmerge + + my ($locks, $data) = lockreadbugmerge($bug_num,$location); + +Performs a filelock, then reads the bug. If the bug is merged, locks +the merge lock. Returns a list of the number of locks and the bug +data. + +=cut + +sub lockreadbugmerge { + my ($bug_num,$location) = @_; + my $data = lockreadbug(@_); + if (not defined $data) { + return (0,undef); + } + if (not length $data->{mergedwith}) { + return (1,$data); + } + unfilelock(); + filelock('lock/merge'); + $data = lockreadbug(@_); + if (not defined $data) { + unfilelock(); + return (0,undef); + } + return (2,$data); +} + + my @v1fieldorder = qw(originator date subject msgid package keywords done forwarded mergedwith severity); @@ -568,6 +599,9 @@ sub bug_archiveable{ days_until => {type => BOOLEAN, default => 0, }, + ignore_time => {type => BOOLEAN, + default => 0, + }, }, ); # This is what we return if the bug cannot be archived. @@ -583,8 +617,9 @@ sub bug_archiveable{ return $cannot_archive if not defined $status->{done} or not length $status->{done}; # 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. - if (not $param{days_until} and $config{remove_age} > - -M getbugcomponent($param{ref},'log') + if (not $param{days_until} and not $param{ignore_time} + and $config{remove_age} > + -M getbugcomponent($param{bug},'log') ) { return $cannot_archive; } @@ -628,6 +663,11 @@ sub bug_archiveable{ # Since the bug has at least been fixed in the architectures # that matters, we check to see how long it has been fixed. + # If $param{ignore_time}, then we should ignore time. + if ($param{ignore_time}) { + return $param{days_until}?0:1; + } + # To do this, we order the times from most recent to oldest; # when we come to the first found version, we stop. # If we run out of versions, we only report the time of the @@ -650,6 +690,10 @@ sub bug_archiveable{ } $min_archive_days = max($min_archive_days,ceil((time - $min_fixed_time)/(60*60*24))); } + # If $param{ignore_time}, then we should ignore time. + if ($param{ignore_time}) { + 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($config{remove_age} - -M getbugcomponent($param{bug},'log')); if ($age > 0 or $min_archive_days > 0) { diff --git a/html/server-control.html.in b/html/server-control.html.in index a9835fc..3c61089 100644 --- a/html/server-control.html.in +++ b/html/server-control.html.in @@ -337,6 +337,18 @@ mailservers is available via the WWW, in
Forgets any idea that the $gBug has an owner other than the usual maintainer. If the $gBug had no owner recorded then this will do nothing. +
archive bugnumber + +
Archives a $gBug that was previously archived if the $gBug + fulfills the requirements for archival, ignoring time. + +
unarchive bugnumber + +
Unarchives a $gBug that was previously archived. Unarchival + should generally be coupled with reopen and found/fixed as + approprite. Bugs that have been unarchived can be archived using + archive assuming the non-time based archival requirements are met. +
#...
One-line comment. The # must be at the start of the line. diff --git a/scripts/errorlib.in b/scripts/errorlib.in index a93c79b..24ce333 100755 --- a/scripts/errorlib.in +++ b/scripts/errorlib.in @@ -13,17 +13,6 @@ sub unlockreadbugmerge { &unfilelock if $rv >= 1; } -sub lockreadbugmerge { - local ($lref, $location) = @_; - local $data; - if (!($data = &lockreadbug($lref, $location))) { return ( 0, undef ); } - if (!length($data->{mergedwith})) { return ( 1, $data ); } - &unfilelock; - &filelock('lock/merge'); - if (!&lockreadbug($lref, $location)) { &unfilelock; return ( 0, undef ); } - return ( 2, $data ); -} - %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot'); sub sani { diff --git a/scripts/expire.in b/scripts/expire.in index 97b4dbc..11943ee 100755 --- a/scripts/expire.in +++ b/scripts/expire.in @@ -1,25 +1,25 @@ #!/usr/bin/perl -# $Id: expire.in,v 1.23 2005/08/09 23:12:07 cjwatson Exp $ +# This script is part of debbugs, and is released +# under the terms of the GPL version 2, or any later +# version at your option. +# See the file README and COPYING for more information. +# +# [Other people may have contributed to this file; their copyrights +# should go here too.] +# Copyright 2004 by Collin Watson +# Copyright 2007 by Don Armstrong -# Load modules and set environment -use File::Copy; -use File::Path; -$config_path = '/etc/debbugs'; -$lib_path = '/usr/lib/debbugs'; -require("$config_path/config"); -require("$config_path/text"); -require("$lib_path/errorlib"); -$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; -# No $gRemoveAge means "never expire". -exit 0 unless $gRemoveAge; +use Debbugs::Control qw(bug_archive); +use Debbugs::Status qw(bug_archiveable); + +use Debbugs::Config qw(:config); -chdir("$gSpoolDir") || die "chdir spool: $!\n"; +# No $gRemoveAge means "never expire". +exit 0 unless $config{remove_age}; -#global variables -$debug = 0; -defined($startdate= time) || &quit("failed to get time: $!"); +chdir($config{spool}) || die "chdir $config{spool} failed: $!\n"; #get list of bugs (ie, status files) opendir(DIR,"db-h") || &quit("opendir db: $!\n"); @@ -31,66 +31,19 @@ foreach my $dir (@dirs) { close(DIR); } +my $bug; +my $errors=0; #process each bug (ie, status file) -while (length($ref=shift(@list))) { - print "$ref considering\n" if $debug; - ($bfound, $data)= &lockreadbugmerge($ref); - print "$ref read $bfound\n" if $debug; - $bfound || next; - print "$ref read ok (done $data->{done})\n" if $debug; - (&unlockreadbugmerge($bfound), next) unless length($data->{done}); - print "$ref read done\n" if $debug; - @aref= ($ref); - if (length($data->{mergedwith})) { - push(@aref,split / /,$data->{mergedwith}); - } - print "$ref aref @aref\n" if $debug; - $oktoremove= 1; - for $mref (@aref) { - print "$ref $mref check\n" if $debug; - if ($mref != $ref) { - print "$ref $mref reading\n" if $debug; - $newdata = &lockreadbug($mref) || die "huh $mref ?"; - print "$ref $mref read ok\n" if $debug; - $bfound++; - } else { - $newdata = $data; - } - print "$ref $mref read/not\n" if $debug; - $expectmerge= join(' ',grep($_ != $mref, sort { $a <=> $b } @aref)); - $newdata->{mergedwith} eq $expectmerge || - die "$ref -> $mref: ($newdata->{mergedwith}) vs. ($expectmerge) (@aref)"; - print "$ref $mref merge-ok\n" if $debug; - length($newdata->{done}) || die "$ref -> $mref"; - print "$ref $mref done-ok\n" if $debug; - $days= -M "db-h/".get_hashname($mref)."/$mref.log"; - print "ref $mref days $days\n" if $debug; - if ($days <= $gRemoveAge) { - print "$ref $mref saved\n" if $debug; - $oktoremove= 0; - } - } - if ($oktoremove) { - print "$ref removing\n" if $debug; - for $mref (@aref) { - print "$ref removing $mref\n" if $debug; - my $dir = get_hashname($mref); - if ($gSaveOldBugs) { - mkpath("archive/$dir"); - link( "db-h/$dir/$mref.log", "archive/$dir/$mref.log" ) || copy( "db-h/$dir/$mref.log", "archive/$dir/$mref.log" ); - link( "db-h/$dir/$mref.status", "archive/$dir/$mref.status" ) || copy( "db-h/$dir/$mref.status", "archive/$dir/$mref.status" ); - link( "db-h/$dir/$mref.summary", "archive/$dir/$mref.summary" ) || copy( "db-h/$dir/$mref.summary", "archive/$dir/$mref.summary" ); - link( "db-h/$dir/$mref.report", "archive/$dir/$mref.report" ) || copy( "db-h/$dir/$mref.report", "archive/$dir/$mref.report" ); - print("archived $mref to archive/$dir (from $ref)\n") || &quit("output old: $!"); - } - unlink("db-h/$dir/$mref.log", "db-h/$dir/$mref.status", "db-h/$dir/$mref.summary", "db-h/$dir/$mref.report"); - print("deleted $mref (from $ref)\n") || &quit("output old: $!"); - bughook_archive($mref); - } - } - print "$ref unlocking $bfound\n" if $debug; - for ($i=0; $i<$bfound; $i++) { &unfilelock; } - print "$ref unlocking done\n" if $debug; +while (length($bug=shift(@list))) { + # Weeeee. + next unless bug_archiveable(bug=>$bug); + eval { + bug_archive(bug=>$bug); + }; + if ($@) { + $errors=1; + print STDERR "Unable to archive bug# $bug which I thought I could archive:\n$@\n"; + } } -close(STDOUT) || &quit("close stdout: $!"); +exit $errors; diff --git a/scripts/process.in b/scripts/process.in index fed541f..8fe313d 100755 --- a/scripts/process.in +++ b/scripts/process.in @@ -14,6 +14,8 @@ use Debbugs::User qw(read_usertags write_usertags); use Debbugs::CGI qw(html_escape); +use Debbugs::Log qw(:misc); + # TODO DLA; needs config reworking and errorlib reworking # use warnings; # use strict; @@ -1069,7 +1071,7 @@ sub appendlog { print DEBUG "failed open log err $!<\n"; &quit("opening db-h/$hash/$ref.log (li): $!"); } - print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!"); + print(AP "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!"); close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!"); } @@ -1153,7 +1155,7 @@ sub sendmessage { #save email to the log open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!"); print(AP "\2\n",join("\4",@$recips),"\n\5\n", - @{escapelog(stripbccs($msg))},"\n\3\n") || + escape_log(stripbccs($msg)),"\n\3\n") || &quit("writing db-h/$hash/$ref.log (lo): $!"); close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!"); diff --git a/scripts/service.in b/scripts/service.in index 0fb1da7..3bf7ae6 100755 --- a/scripts/service.in +++ b/scripts/service.in @@ -13,6 +13,9 @@ use HTML::Entities qw(encode_entities); use Debbugs::Config qw(:globals :config); use Debbugs::CGI qw(html_escape); +use Debbugs::Control qw(:archive :log); +use Debbugs::Log qw(:misc); + $lib_path = $gLibPath; require "$lib_path/errorlib"; $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; @@ -1179,6 +1182,53 @@ END &nochangebug; } } + } elsif (m/^unarchive\s+#?(\d+)$/i) { + $ok++; + $ref = $1; + $bug_affected{$ref} = 1; + my $transcript; + eval { + bug_unarchive(bug => $ref, + transcript => \$transcript, + affected_bugs => \%bug_affected, + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + ); + }; + if ($@) { + $errors++; + } + transcript($transcript."\n"); + } elsif (m/^archive\s+#?(\d+)$/i) { + $ok++; + $ref = $1; + $bug_affected{$ref} = 1; + if (&setbug) { + if (exists $data->{unarchived}) { + my $transcript; + nochangebug(); + eval { + bug_archive(bug => $ref, + transcript => \$transcript, + ignore_time => 1, + affected_bugs => \%bug_affected, + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + ); + }; + if ($@) { + $errors++; + } + transcript($transcript."\n"); + } + else { + transcript("$gBug $ref has not been archived previously\n\n"); + nochangebug(); + $errors++; + } + } } else { &transcript("Unknown command or malformed arguments to command.\n\n"); $errors++; @@ -1264,6 +1314,7 @@ $extras END $repliedshow= join(', ',$replyto,@maintccaddrs); +# -1 is the service.in log &filelock("lock/-1"); open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!"); print(AP @@ -1273,7 +1324,7 @@ print(AP html_escape($header{'from'})."\n". "to ".html_escape($controlrequestaddr)."\n". "\3\n". - "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!"); + "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!"); close(AP) || &quit("open db-h/-1.log: $!"); &unfilelock; utime(time,time,"db-h"); @@ -1499,17 +1550,13 @@ sub savebug { $lowstate eq 'open' || die "$lowstate ?"; length($action) || die; $ref == $sref || die "read $sref but saving $ref ?"; - my $hash = get_hashname($ref); - open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!"); - print(L - "\6\n". - "\n". - "".html_escape($action)."\n". - "Request was from ".html_escape($header{'from'})."\n". - "to ".html_escape($controlrequestaddr).". \n". - "\3\n". - "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!"); - close(L) || &quit("closing db-h/$hash/$ref.log: $!"); + append_action_to_log(bug => $ref, + action => $action, + requester => $header{from}, + request_addr => $controlrequestaddr, + message => \@log, + get_lock => 0, + ); unlockwritebug($ref, $data); $lowstate= "idle"; &dlex("savebug"); diff --git a/t/06_mail_handling.t b/t/06_mail_handling.t index 48f6cb8..4f8e89d 100644 --- a/t/06_mail_handling.t +++ b/t/06_mail_handling.t @@ -1,7 +1,7 @@ # -*- mode: cperl;-*- # $Id: 05_mail.t,v 1.1 2005/08/17 21:46:17 don Exp $ -use Test::More tests => 43; +use Test::More tests => 52; use warnings; use strict; @@ -113,7 +113,7 @@ ok(system('sh','-c','find '.$sendmail_dir.q( -type f | xargs grep -q "Subject: P 'control@bugs.something message was parsed without errors'); # now we need to check to make sure that the control message actually did anything # This is an eval because $ENV{DEBBUGS_CONFIG_FILE} isn't set at BEGIN{} time -eval "use Debbugs::Status qw(read_bug);"; +eval "use Debbugs::Status qw(read_bug writebug);"; my $status = read_bug(bug=>1); ok($status->{subject} eq 'new title','bug 1 retitled'); ok($status->{severity} eq 'wishlist','bug 1 wishlisted'); @@ -176,9 +176,28 @@ my @control_commands = status_key => 'owner', status_value => '', }, - + close => {command => 'close', + value => '', + status_key => 'done', + status_value => 'foo@bugs.something', + }, + archive => {command => 'archive', + value => '', + status_key => 'owner', + status_value => '', + location => 'archive', + }, + unarchive => {command => 'unarchive', + value => '', + status_key => 'owner', + status_value => '', + }, ); +# In order for the archive/unarchive to work, we have to munge the summary file slightly +$status = read_bug(bug => 1); +$status->{unarchived} = time; +writebug(1,$status); while (my ($command,$control_command) = splice(@control_commands,0,2)) { # just check to see that control doesn't explode $control_command->{value} = " $control_command->{value}" if length $control_command->{value} @@ -200,7 +219,10 @@ EOF 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 = read_bug(bug=>1); + my $status; + $status = read_bug(bug=>1, + exists $control_command->{location}?(location => $control_command->{location}):(), + ); is_deeply($status->{$control_command->{status_key}},$control_command->{status_value},"bug 1 $command") or fail(Dumper($status)); } -- 2.39.2