=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
'[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
--- /dev/null
+# 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 <don@donarmstrong.com>.
+
+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<append_log> (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".
+ "<!-- time:".time." -->\n".
+ "<strong>".html_escape($param{action})."</strong>\n".
+ "Request was from <code>".html_escape($param{requester})."</code>\n".
+ "to <code>".html_escape($param{request_addr})."</code>. \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} = <<END;
+To: $param{request_addr}
+From: $param{requester}
+Subject: Internal Control
+Message-Id: $action
+User-Agent: Fakemail v42.6.9
+
+# A New Hope
+# A log time ago, in a galaxy far, far away
+# something happened.
+#
+# Magically this resulted in the following
+# action being taken, but this fake control
+# message doesn't tell you why it happened
+#
+# The action:
+# $action
+thanks
+# This fakemail brought to you by your local debbugs
+# administrator
+END
+ }
+ return (action => $action,
+ %param);
+}
+
+
+1;
+
+__END__
#
# [Other people have contributed to this file; their copyrights should
# go here too.]
-# Copyright 2004 by Collin Waston <cjwatson@debian.org>
+# Copyright 2004 by Collin Watson <cjwatson@debian.org>
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>
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
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";
} 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'";
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
%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)
fixed_date => 'fixed-date',
blocks => 'blocks',
blockedby => 'blocked-by',
+ unarchived => 'unarchived',
);
# Fields which need to be RFC1522-decoded in format versions earlier than 3.
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);
days_until => {type => BOOLEAN,
default => 0,
},
+ ignore_time => {type => BOOLEAN,
+ default => 0,
+ },
},
);
# This is what we return if the bug cannot be archived.
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;
}
# 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
}
$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) {
<dd>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.
+<dt><code>archive</code> <var>bugnumber</var>
+
+ <dd>Archives a $gBug that was previously archived if the $gBug
+ fulfills the requirements for archival, ignoring time.
+
+<dt><code>unarchive</code> <var>bugnumber</var>
+
+ <dd>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.
+
<dt><code>#</code>...
<dd>One-line comment. The <code>#</code> must be at the start of the line.
&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 {
#!/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 <cjwatson@debian.org>
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>
-# 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");
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;
use Debbugs::CGI qw(html_escape);
+use Debbugs::Log qw(:misc);
+
# TODO DLA; needs config reworking and errorlib reworking
# use warnings;
# use strict;
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): $!");
}
#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): $!");
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'};
&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++;
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
html_escape($header{'from'})."</code>\n".
"to <code>".html_escape($controlrequestaddr)."</code>\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");
$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".
- "<!-- time:".time." -->\n".
- "<strong>".html_escape($action)."</strong>\n".
- "Request was from <code>".html_escape($header{'from'})."</code>\n".
- "to <code>".html_escape($controlrequestaddr)."</code>. \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");
# -*- 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;
'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');
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}
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));
}
projects / debbugs.git / commitdiff