1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
23 This module is an abstraction of a lot of functions which originally
24 were only present in service.in, but as time has gone on needed to be
25 called from elsewhere.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item location -- Optional location; currently ignored but may be
53 supported in the future for updating archived bugs upon archival
55 =item message -- The original message which caused the action to be taken
57 =item append_log -- Whether or not to append information to the log.
61 B<append_log> (for most functions) is a special option. When set to
62 false, no appending to the log is done at all. When it is not present,
63 the above information is faked, and appended to the log file. When it
64 is true, the above options must be present, and their values are used.
73 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
74 use base qw(Exporter);
78 $DEBUG = 0 unless defined $DEBUG;
81 %EXPORT_TAGS = (archive => [qw(bug_archive bug_unarchive),
83 log => [qw(append_action_to_log),
87 Exporter::export_ok_tags(qw(archive log));
88 $EXPORT_TAGS{all} = [@EXPORT_OK];
91 use Debbugs::Config qw(:config);
92 use Debbugs::Common qw(:lock buglog make_list get_hashname);
93 use Debbugs::Status qw(bug_archiveable :read :hook);
94 use Debbugs::CGI qw(html_escape);
95 use Debbugs::Log qw(:misc);
97 use Params::Validate qw(validate_with :types);
98 use File::Path qw(mkpath);
101 use POSIX qw(strftime);
103 # These are a set of options which are common to all of these functions
105 my %common_options = (debug => {type => SCALARREF,
108 transcript => {type => SCALARREF,
111 affected_bugs => {type => HASHREF,
117 my %append_action_options =
118 (action => {type => SCALAR,
121 requester => {type => SCALAR,
124 request_addr => {type => SCALAR,
127 location => {type => SCALAR,
130 message => {type => SCALAR|ARRAYREF,
133 append_log => {type => BOOLEAN,
135 depends => [qw(requester request_addr),
146 bug_archive(bug => $bug_num,
148 transcript => \$transcript,
153 transcript("Unable to archive $bug_num\n");
156 transcript($transcript);
159 This routine archives a bug
164 my %param = validate_with(params => \@_,
165 spec => {bug => {type => SCALAR,
168 check_archiveable => {type => BOOLEAN,
171 ignore_time => {type => BOOLEAN,
175 %append_action_options,
179 local $SIG{__DIE__} = sub {
181 for (1..$locks) { unfilelock(); }
185 my $action = "$config{bug} archived.";
186 my ($debug,$transcript) = __handle_debug_transcript(%param);
187 if ($param{check_archiveable} and
188 not bug_archiveable(bug=>$param{bug},
189 ignore_time => $param{ignore_time},
191 print {$transcript} "Bug $param{bug} cannot be archived\n";
192 die "Bug $param{bug} cannot be archived";
194 print {$debug} "$param{bug} considering\n";
196 ($locks, $data) = lockreadbugmerge($param{bug});
197 print {$debug} "$param{bug} read $locks\n";
198 defined $data or die "No bug found for $param{bug}";
199 print {$debug} "$param{bug} read ok (done $data->{done})\n";
200 print {$debug} "$param{bug} read done\n";
201 my @bugs = ($param{bug});
203 # @bugs{@bugs} = (1) x @bugs;
204 if (length($data->{mergedwith})) {
205 push(@bugs,split / /,$data->{mergedwith});
207 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
208 for my $bug (@bugs) {
210 print {$debug} "$param{bug} $bug check\n";
211 if ($bug != $param{bug}) {
212 print {$debug} "$param{bug} $bug reading\n";
213 $newdata = lockreadbug($bug) || die "huh $bug ?";
214 print {$debug} "$param{bug} $bug read ok\n";
219 print {$debug} "$param{bug} $bug read/not\n";
220 my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs));
221 $newdata->{mergedwith} eq $expectmerge ||
222 die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
223 print {$debug} "$param{bug} $bug merge-ok\n";
224 if ($param{check_archiveable}) {
225 die "Bug $bug cannot be archived (but $param{bug} can?)"
226 unless bug_archiveable(bug=>$bug,
227 ignore_time => $param{ignore_time},
231 # If we get here, we can archive/remove this bug
232 print {$debug} "$param{bug} removing\n";
233 for my $bug (@bugs) {
234 #print "$param{bug} removing $bug\n" if $debug;
235 my $dir = get_hashname($bug);
236 # First indicate that this bug is being archived
237 append_action_to_log(bug => $bug,
239 __return_append_to_log_options(
240 (map {exists $param{$_}?($_,$param{$_}):()}
241 keys %append_action_options,
246 if not exists $param{append_log} or $param{append_log};
247 my @files_to_remove = map {s#db-h/$dir/##; $_} glob("db-h/$dir/$bug.*");
248 if ($config{save_old_bugs}) {
249 mkpath("archive/$dir");
250 foreach my $file (@files_to_remove) {
251 link( "db-h/$dir/$file", "archive/$dir/$file" ) || copy( "db-h/$dir/$file", "archive/$dir/$file" );
254 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
256 unlink(map {"db-h/$dir/$_"} @files_to_remove);
257 print {$transcript} "deleted $bug (from $param{bug})\n";
259 bughook_archive(@bugs);
260 if (exists $param{bugs_affected}) {
261 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
263 print {$debug} "$param{bug} unlocking $locks\n";
265 for (1..$locks) { unfilelock(); }
267 print {$debug} "$param{bug} unlocking done\n";
274 bug_unarchive(bug => $bug_num,
276 transcript => \$transcript,
281 transcript("Unable to archive bug: $bug_num");
283 transcript($transcript);
285 This routine unarchives a bug
290 my %param = validate_with(params => \@_,
291 spec => {bug => {type => SCALAR,
295 %append_action_options,
298 my $action = "$config{bug} unarchived.";
299 my ($debug,$transcript) = __handle_debug_transcript(%param);
300 print {$debug} "$param{bug} considering\n";
301 my ($locks, $data) = lockreadbugmerge($param{bug},'archive');
302 print {$debug} "$param{bug} read $locks\n";
303 if (not defined $data) {
304 print {$transcript} "No bug found for $param{bug}\n";
305 die "No bug found for $param{bug}";
307 print {$debug} "$param{bug} read ok (done $data->{done})\n";
308 print {$debug} "$param{bug} read done\n";
309 my @bugs = ($param{bug});
311 # @bugs{@bugs} = (1) x @bugs;
312 if (length($data->{mergedwith})) {
313 push(@bugs,split / /,$data->{mergedwith});
315 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
316 for my $bug (@bugs) {
318 print {$debug} "$param{bug} $bug check\n";
319 if ($bug != $param{bug}) {
320 print {$debug} "$param{bug} $bug reading\n";
321 $newdata = lockreadbug($bug,'archive') or die "huh $bug ?";
322 print {$debug} "$param{bug} $bug read ok\n";
327 print {$debug} "$param{bug} $bug read/not\n";
328 my $expectmerge= join(' ',grep($_ != $bug, sort { $a <=> $b } @bugs));
329 if ($newdata->{mergedwith} ne $expectmerge ) {
330 print {$transcript} "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)";
331 die "$param{bug} differs from $bug: ($newdata->{mergedwith}) vs. ($expectmerge) (@bugs)";
333 print {$debug} "$param{bug} $bug merge-ok\n";
335 # If we get here, we can archive/remove this bug
336 print {$debug} "$param{bug} removing\n";
338 for my $bug (@bugs) {
339 print {$debug} "$param{bug} removing $bug\n";
340 my $dir = get_hashname($bug);
341 my @files_to_copy = map {s#archive/$dir/##; $_} glob("archive/$dir/$bug.*");
342 mkpath("archive/$dir");
343 foreach my $file (@files_to_copy) {
345 link( "archive/$dir/$file", "db-h/$dir/$file" ) or
346 copy( "archive/$dir/$file", "db-h/$dir/$file" ) or
347 die "Unable to copy archive/$dir/$file to db-h/$dir/$file";
349 push @files_to_remove, map {"archive/$dir/$_"} @files_to_copy;
350 print {$transcript} "Unarchived $config{bug} $bug\n";
352 unlink(@files_to_remove) or die "Unable to unlink bugs";
353 # Indicate that this bug has been archived previously
354 for my $bug (@bugs) {
355 my $newdata = readbug($bug);
356 if (not defined $newdata) {
357 print {$transcript} "$config{bug} $bug disappeared!\n";
358 die "Bug $bug disappeared!";
360 $newdata->{unarchived} = time;
361 append_action_to_log(bug => $bug,
363 __return_append_to_log_options(
364 (map {exists $param{$_}?($_,$param{$_}):()}
365 keys %append_action_options,
370 if not exists $param{append_log} or $param{append_log};
371 writebug($bug,$newdata);
373 print {$debug} "$param{bug} unlocking $locks\n";
375 for (1..$locks) { unfilelock(); };
377 if (exists $param{bugs_affected}) {
378 @{$param{bugs_affected}}{@bugs} = (1) x @bugs;
380 print {$debug} "$param{bug} unlocking done\n";
383 =head2 append_action_to_log
387 This should probably be moved to Debbugs::Log; have to think that out
392 sub append_action_to_log{
393 my %param = validate_with(params => \@_,
394 spec => {bug => {type => SCALAR,
397 action => {type => SCALAR,
399 requester => {type => SCALAR,
401 request_addr => {type => SCALAR,
403 location => {type => SCALAR,
406 message => {type => SCALAR|ARRAYREF,
408 get_lock => {type => BOOLEAN,
413 # Fix this to use $param{location}
414 my $log_location = buglog($param{bug});
415 die "Unable to find .log for $param{bug}"
416 if not defined $log_location;
417 if ($param{get_lock}) {
418 filelock("lock/$param{bug}");
420 my $log = IO::File->new(">>$log_location") or
421 die "Unable to open $log_location for appending: $!";
423 "<!-- time:".time." -->\n".
424 "<strong>".html_escape($param{action})."</strong>\n".
425 "Request was from <code>".html_escape($param{requester})."</code>\n".
426 "to <code>".html_escape($param{request_addr})."</code>. \n".
428 "\7\n",escape_log(make_list($param{message})),"\n\3\n"
429 or die "Unable to append to $log_location: $!";
430 close $log or die "Unable to close $log_location: $!";
431 if ($param{get_lock}) {
439 =head1 PRIVATE FUNCTIONS
441 =head2 __handle_debug_transcript
443 my ($debug,$transcript) = __handle_debug_transcript(%param);
445 Returns a debug and transcript IO::Scalar filehandle
450 sub __handle_debug_transcript{
451 my %param = validate_with(params => \@_,
452 spec => {%common_options},
456 my $debug = IO::Scalar->new(exists $param{debug}?$param{debug}:\$fake_scalar);
457 my $transcript = IO::Scalar->new(exists $param{transcript}?$param{transcript}:\$fake_scalar);
458 return ($debug,$transcript);
462 sub __return_append_to_log_options{
464 my $action = 'Unknown action';
465 if (not exists $param{requester}) {
466 $param{requester} = $config{control_internal_requester};
468 if (not exists $param{request_addr}) {
469 $param{request_addr} = $config{control_internal_request_addr};
471 if (not exists $param{message}) {
472 $action = $param{action} if exists $param{action};
473 my $date = strftime "%a, %d %h %Y %T +0000", gmtime;
474 $param{message} = <<END;
475 Received: (at fakecontrol) by fakecontrolmessage;
476 To: $param{request_addr}
477 From: $param{requester}
478 Subject: Internal Control
481 User-Agent: Fakemail v42.6.9
484 # A log time ago, in a galaxy far, far away
485 # something happened.
487 # Magically this resulted in the following
488 # action being taken, but this fake control
489 # message doesn't tell you why it happened
494 # This fakemail brought to you by your local debbugs
498 return (action => $action,