2 # $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
11 use Debbugs::Config qw(:globals :config);
16 use Params::Validate qw(:types validate_with);
18 use Debbugs::Common qw(:util :quit :misc :lock);
20 use Debbugs::Status qw(:read :status :write :versions);
22 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
23 use Debbugs::Mail qw(send_mail_message);
25 use Debbugs::Recipients qw(:all);
26 use HTML::Entities qw(encode_entities);
27 use Debbugs::Versions::Dpkg;
29 use Debbugs::Status qw(splitpackages);
31 use Debbugs::CGI qw(html_escape);
32 use Debbugs::Control qw(:all);
33 use Debbugs::Log qw(:misc);
34 use Debbugs::Text qw(:templates);
36 use Mail::RFC822::Address;
38 chdir($config{spool_dir}) or
39 die "Unable to chdir to spool_dir '$config{spool_dir}': $!";
44 my ($nn,$control) = $ARGV[0] =~ m/^(([RC])\.\d+)$/;
45 if (not defined $control or not defined $nn) {
46 die "Bad argument to service.in";
48 if (!rename("incoming/G$nn","incoming/P$nn")) {
49 defined $! and $! =~ m/no such file or directory/i and exit 0;
50 die "Failed to rename incoming/G$nn to incoming/P$nn: $!";
53 my $log_fh = IO::File->new("incoming/P$nn",'r') or
54 die "Unable to open incoming/P$nn for reading: $!";
61 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
63 # Bug numbers to send e-mail to, hash so that we don't send to the
67 my (@headerlines,@bodylines);
69 my $parse_output = Debbugs::MIME::parse(join('',@log));
70 @headerlines = @{$parse_output->{header}};
71 @bodylines = @{$parse_output->{body}};
75 $_ = decode_rfc1522($_);
77 print ">$_<\n" if $debug;
80 print ">$v=$_<\n" if $debug;
83 print "!>$_<\n" if $debug;
86 $header{'message-id'} ||= '';
88 grep(s/\s+$//,@bodylines);
90 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
92 if (defined $header{'resent-from'} && !defined $header{'from'}) {
93 $header{'from'} = $header{'resent-from'};
96 defined($header{'from'}) || die "no From header";
98 delete $header{'reply-to'}
99 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
102 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
103 $replyto = $header{'reply-to'};
105 $replyto = $header{'from'};
108 # This is an error counter which should be incremented every time there is an error.
110 my $controlrequestaddr= ($control ? 'control' : 'request').$config{email_domain};
111 my $transcript_scalar = '';
112 my $transcript = IO::Scalar->new(\$transcript_scalar) or
113 die "Unable to create new IO::Scalar";
114 print {$transcript} "Processing commands for $controlrequestaddr:\n\n";
119 my $lowstate= 'idle';
120 my $mergelowstate= 'idle';
125 $user =~ s/^.*<(.*)>.*$/$1/;
126 $user =~ s/[(].*[)]//;
127 $user =~ s/^\s*(\S+)\s+.*$/$1/;
128 $user = "" unless (Debbugs::User::is_valid_user($user));
129 my $indicated_user = 0;
134 if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) {
135 print {$transcript} fill_template('mail/excluded_from_control');
146 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
161 my %affected_packages;
165 for ($procline=0; $procline<=$#bodylines; $procline++) {
170 $state eq 'idle' || print "state: $state ?\n";
171 $lowstate eq 'idle' || print "lowstate: $lowstate ?\n";
172 $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n";
174 print {$transcript} "Stopping processing here.\n\n";
177 $_= $bodylines[$procline]; s/\s+$//;
179 print {$transcript} "> $_\n";
182 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
183 print {$transcript} "Stopping processing here.\n\n";
185 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
187 print {$transcript} "Debug level $dl.\n\n";
188 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
190 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
191 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
193 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
194 "detailed logs for $gBug#$ref");
195 } elsif (m/^index(\s+full)?$/i) {
196 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
198 $ok++; # well, it's not really ok, but it fixes #81224 :)
199 } elsif (m/^index-summary\s+by-package$/i) {
200 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
202 $ok++; # well, it's not really ok, but it fixes #81224 :)
203 } elsif (m/^index-summary(\s+by-number)?$/i) {
204 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
206 $ok++; # well, it's not really ok, but it fixes #81224 :)
207 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
208 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
209 } elsif (m/^index(\s+|-)maints?$/i) {
210 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
211 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
213 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
214 "$gBug list for maintainer \`$maint'");
216 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
218 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
219 "$gBug list for package $package");
221 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
222 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
224 $ok++; # well, it's not really ok, but it fixes #81224 :)
225 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
226 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
228 $ok++; # well, it's not really ok, but it fixes #81224 :)
229 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
230 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
232 $ok++; # well, it's not really ok, but it fixes #81224 :)
233 } elsif (m/^getinfo\s+([\w.-]+)$/i) {
234 # the following is basically a Debian-specific kludge, but who cares
236 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
237 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
238 } elsif ($req =~ /^override\.(\w+)\.([\w.-]+)$/i) {
240 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
241 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
242 &sendinfo("local", "$gConfigDir/$req", "$req file");
244 print {$transcript} "Info file $req does not exist.\n\n";
246 } elsif (m/^help/i) {
248 print {$transcript} "\n";
250 } elsif (m/^refcard/i) {
251 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
252 } elsif (m/^subscribe/i) {
253 print {$transcript} <<END;
254 There is no $gProject $gBug mailing list. If you wish to review bug reports
255 please do so via http://$gWebDomain/ or ask this mail server
257 soon: MAILINGLISTS_TEXT
259 } elsif (m/^unsubscribe/i) {
260 print {$transcript} <<END;
261 soon: UNSUBSCRIBE_TEXT
262 soon: MAILINGLISTS_TEXT
264 } elsif (m/^user\s+(\S+)\s*$/i) {
266 if (Debbugs::User::is_valid_user($newuser)) {
267 my $olduser = ($user ne "" ? " (was $user)" : "");
268 print {$transcript} "Setting user to $newuser$olduser.\n";
272 print {$transcript} "Selected user id ($newuser) invalid, sorry\n";
277 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
280 my $hidden = ($2 ne "");
287 print {$transcript} "No valid user selected\n";
291 if (not $indicated_user and defined $user) {
292 print {$transcript} "User is $user\n";
296 while (++$procline <= $#bodylines) {
297 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
301 print {$transcript} "> $bodylines[$procline]\n";
303 my ($o, $txt) = ($1, $2);
304 if ($#cats == -1 && $o eq "+") {
305 print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n";
311 unless (ref($cats[-1]) eq "HASH") {
312 $cats[-1] = { "nam" => $cats[-1],
313 "pri" => [], "ttl" => [] };
316 my ($desc, $ord, $op);
317 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
318 $desc = $1; $ord = $3; $op = "";
319 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
320 $desc = $1; $ord = $3; $op = $4;
321 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
322 $desc = ""; $op = $1;
324 print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n";
329 $ord = 999 unless defined $ord;
332 push @{$cats[-1]->{"pri"}}, $prefix . $op;
333 push @{$cats[-1]->{"ttl"}}, $desc;
334 push @ords, "$ord $catsec";
336 $cats[-1]->{"def"} = $desc;
337 push @ords, "$ord DEF";
340 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
341 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
342 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
343 } elsif ($o eq "*") {
346 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
347 $name = $1; $prefix = $3;
349 $name = $txt; $prefix = "";
354 # XXX: got @cats, now do something with it
355 my $u = Debbugs::User::get_user($user);
357 print {$transcript} "Added usercategory $catname.\n\n";
358 $u->{"categories"}->{$catname} = [ @cats ];
360 push @{$u->{visible_cats}},$catname;
363 print {$transcript} "Removed usercategory $catname.\n\n";
364 delete $u->{"categories"}->{$catname};
365 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
368 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
371 my $addsubcode = $3 || "+";
373 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
374 $ref = $clonebugs{$ref};
377 print {$transcript} "No valid user selected\n";
381 if (not $indicated_user and defined $user) {
382 print {$transcript} "User is $user\n";
387 Debbugs::User::read_usertags(\%ut, $user);
388 my @oldtags = (); my @newtags = (); my @badtags = ();
390 for my $t (split /[,\s]+/, $tags) {
391 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
398 print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
401 for my $t (keys %chtags) {
402 $ut{$t} = [] unless defined $ut{$t};
404 for my $t (keys %ut) {
405 my %res = map { ($_, 1) } @{$ut{$t}};
406 push @oldtags, $t if defined $res{$ref};
407 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
408 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
409 : $addsubcode eq "=");
410 $res{$ref} = 1 if ($addop && defined $chtags{$t});
411 delete $res{$ref} if ($del);
412 push @newtags, $t if defined $res{$ref};
413 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
416 print {$transcript} "There were no usertags set.\n";
418 print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
420 print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
421 Debbugs::User::write_usertags(\%ut, $user);
423 } elsif (!$control) {
424 print {$transcript} <<END;
425 Unknown command or malformed arguments to command.
426 (Use control\@$gEmailDomain to manipulate reports.)
430 if (++$unknowns >= 3) {
431 print {$transcript} "Too many unknown commands, stopping here.\n\n";
434 #### "developer only" ones start here
435 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
438 $bug_affected{$ref}=1;
441 print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
442 if (length($data->{done}) and not defined($version)) {
443 print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
448 "marked as fixed in version $version" :
450 ", send any further explanations to $data->{originator}";
452 $affected_packages{$data->{package}} = 1;
453 add_recipients(data => $data,
454 recipients => \%recipients,
455 actions_taken => {done => 1},
457 $data->{done}= $replyto;
458 my @keywords= split ' ', $data->{keywords};
459 my $extramessage = '';
460 if (grep $_ eq 'pending', @keywords) {
461 $extramessage= "Removed pending tag.\n";
462 $data->{keywords}= join ' ', grep $_ ne 'pending',
465 addfixedversions($data, $data->{package}, $version, 'binary');
468 From: $gMaintainerEmail ($gProject $gBug Tracking System)
469 To: $data->{originator}
470 Subject: $gBug#$ref acknowledged by developer
472 References: $header{'message-id'} $data->{msgid}
473 In-Reply-To: $data->{msgid}
474 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
475 Reply-To: $ref\@$gEmailDomain
476 X-$gProject-PR-Message: they-closed-control $ref
478 This is an automatic notification regarding your $gBug report
479 #$ref: $data->{subject},
480 which was filed against the $data->{package} package.
482 It has been marked as closed by one of the developers, namely
485 You should be hearing from them with a substantive response shortly,
486 in case you haven't already. If not, please contact them directly.
489 (administrator, $gProject $gBugs database)
492 &sendmailmessage($message,$data->{originator});
493 } while (&getnextbug);
496 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
500 $bug_affected{$ref}=1;
502 $newpackage =~ y/A-Z/a-z/;
504 if (length($data->{package})) {
505 $action= "$gBug reassigned from package \`$data->{package}'".
506 " to \`$newpackage'.";
508 $action= "$gBug assigned to package \`$newpackage'.";
511 $affected_packages{$data->{package}} = 1;
512 add_recipients(data => $data, recipients => \%recipients);
513 $data->{package}= $newpackage;
514 $data->{found_versions}= [];
515 $data->{fixed_versions}= [];
516 # TODO: what if $newpackage is a source package?
517 addfoundversions($data, $data->{package}, $version, 'binary');
518 add_recipients(data => $data, recipients => \%recipients);
519 } while (&getnextbug);
521 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
522 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
523 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
524 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
527 $bug_affected{$ref}=1;
529 if (@{$data->{fixed_versions}}) {
530 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\nyou may need to use 'found' to remove fixed versions.\n";
532 if (!length($data->{done})) {
533 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
537 $noriginator eq '' ? "$gBug reopened, originator not changed." :
538 "$gBug reopened, originator set to $noriginator.";
540 $affected_packages{$data->{package}} = 1;
541 add_recipients(data => $data, recipients => \%recipients);
542 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
543 $data->{fixed_versions}= [];
545 } while (&getnextbug);
548 } elsif (m{^found\s+\#?(-?\d+)
549 (?:\s+((?:$config{package_name_re}\/)?
550 $config{package_version_re}))?$}ix) {
555 if (!length($data->{done}) and not defined($version)) {
556 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
562 "$gBug marked as found in version $version." :
565 $affected_packages{$data->{package}} = 1;
566 add_recipients(data => $data, recipients => \%recipients);
567 # The 'done' field gets a bit weird with version
568 # tracking, because a bug may be closed by multiple
569 # people in different branches. Until we have something
570 # more flexible, we set it every time a bug is fixed,
571 # and clear it when a bug is found in a version greater
572 # than any version in which the bug is fixed or when
573 # a bug is found and there is no fixed version
574 if (defined $version) {
575 my ($version_only) = $version =~ m{([^/]+)$};
576 addfoundversions($data, $data->{package}, $version, 'binary');
577 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
578 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
579 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
580 $action = "$gBug marked as found in version $version and reopened."
581 if length $data->{done};
585 # Versionless found; assume old-style "not fixed at
587 $data->{fixed_versions} = [];
590 } while (&getnextbug);
593 } elsif (m[^notfound\s+\#?(-?\d+)\s+
594 ((?:$config{package_name_re}\/)?
600 $action= "$gBug no longer marked as found in version $version.";
601 if (length($data->{done})) {
602 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
605 $affected_packages{$data->{package}} = 1;
606 add_recipients(data => $data, recipients => \%recipients);
607 removefoundversions($data, $data->{package}, $version, 'binary');
608 } while (&getnextbug);
611 elsif (m[^fixed\s+\#?(-?\d+)\s+
612 ((?:$config{package_name_re}\/)?
613 $config{package_version_re})\s*$]ix) {
620 "$gBug marked as fixed in version $version." :
623 $affected_packages{$data->{package}} = 1;
624 add_recipients(data => $data, recipients => \%recipients);
625 addfixedversions($data, $data->{package}, $version, 'binary');
626 } while (&getnextbug);
629 elsif (m[^notfixed\s+\#?(-?\d+)\s+
630 ((?:$config{package_name_re}\/)?
638 "$gBug no longer marked as fixed in version $version." :
641 $affected_packages{$data->{package}} = 1;
642 add_recipients(data => $data, recipients => \%recipients);
643 removefixedversions($data, $data->{package}, $version, 'binary');
644 } while (&getnextbug);
647 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
648 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
651 $bug_affected{$ref}=1;
652 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
653 $ref = $clonebugs{$ref};
655 if (not Mail::RFC822::Address::valid($newsubmitter)) {
656 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
660 if (&checkpkglimit) {
662 $affected_packages{$data->{package}} = 1;
663 add_recipients(data => $data, recipients => \%recipients);
664 $oldsubmitter= $data->{originator};
665 $data->{originator}= $newsubmitter;
666 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
668 print {$transcript} "$action\n";
669 if (length($data->{done})) {
670 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
672 print {$transcript} "\n";
674 From: $gMaintainerEmail ($gProject $gBug Tracking System)
676 Subject: $gBug#$ref submitter address changed
678 References: $header{'message-id'} $data->{msgid}
679 In-Reply-To: $data->{msgid}
680 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
681 Reply-To: $ref\@$gEmailDomain
682 X-$gProject-PR-Message: submitter-changed $ref
684 The submitter address recorded for your $gBug report
685 #$ref: $data->{subject}
688 The old submitter address for this report was
690 The new submitter address is
693 This change was made by
695 If it was incorrect, please contact them directly.
698 (administrator, $gProject $gBugs database)
701 &sendmailmessage($message,$oldsubmitter);
708 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
712 $bug_affected{$ref}=1;
714 if (length($data->{forwarded})) {
715 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
717 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
719 if (length($data->{done})) {
720 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
723 $affected_packages{$data->{package}} = 1;
724 add_recipients(data => $data,
725 recipients => \%recipients,
726 actions_taken => {forwarded => 1},
728 $data->{forwarded}= $whereto;
729 } while (&getnextbug);
731 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
734 $bug_affected{$ref}=1;
736 if (!length($data->{forwarded})) {
737 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
740 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
742 $affected_packages{$data->{package}} = 1;
743 add_recipients(data => $data, recipients => \%recipients);
744 $data->{forwarded}= '';
745 } while (&getnextbug);
748 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
749 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
752 $bug_affected{$ref}=1;
754 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
755 print {$transcript} "Severity level \`$newseverity' is not known.\n".
756 "Recognized are: $gShowSeverities.\n\n";
758 } elsif (exists $gObsoleteSeverities{$newseverity}) {
759 print {$transcript} "Severity level \`$newseverity' is obsolete. " .
760 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
763 my $printseverity= $data->{severity};
764 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
765 $action= "Severity set to \`$newseverity' from \`$printseverity'";
767 $affected_packages{$data->{package}} = 1;
768 add_recipients(data => $data, recipients => \%recipients);
769 if (defined $gStrongList and isstrongseverity($newseverity)) {
770 addbcc("$gStrongList\@$gListDomain");
772 $data->{severity}= $newseverity;
773 } while (&getnextbug);
775 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
780 $bug_affected{$ref}=1;
782 if (defined $addsubcode) {
783 $addsub = "sub" if ($addsubcode eq "-");
784 $addsub = "add" if ($addsubcode eq "+");
785 $addsub = "set" if ($addsubcode eq "=");
789 foreach my $t (split /[\s,]+/, $tags) {
790 if (!grep($_ eq $t, @gTags)) {
797 print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
798 "Recognized are: ".join(' ', @gTags).".\n\n";
802 if ($data->{keywords} eq '') {
803 print {$transcript} "There were no tags set.\n";
805 print {$transcript} "Tags were: $data->{keywords}\n";
807 if ($addsub eq "set") {
808 $action= "Tags set to: " . join(", ", @okaytags);
809 } elsif ($addsub eq "add") {
810 $action= "Tags added: " . join(", ", @okaytags);
811 } elsif ($addsub eq "sub") {
812 $action= "Tags removed: " . join(", ", @okaytags);
815 $affected_packages{$data->{package}} = 1;
816 add_recipients(data => $data, recipients => \%recipients);
817 $data->{keywords} = '' if ($addsub eq "set");
818 # Allow removing obsolete tags.
819 if ($addsub eq "sub") {
820 foreach my $t (@badtags) {
821 $data->{keywords} = join ' ', grep $_ ne $t,
822 split ' ', $data->{keywords};
825 # Now process all other additions and subtractions.
826 foreach my $t (@okaytags) {
827 $data->{keywords} = join ' ', grep $_ ne $t,
828 split ' ', $data->{keywords};
829 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
831 $data->{keywords} =~ s/\s*$//;
832 } while (&getnextbug);
834 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
836 my $bugnum = $2; my $blockers = $4;
838 $addsub = "sub" if ($1 eq "un");
839 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
840 $bugnum = $clonebugs{$bugnum};
845 foreach my $b (split /[\s,]+/, $blockers) {
849 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
850 $ref = $clonebugs{$ref};
854 push @okayblockers, $ref;
856 # add to the list all bugs that are merged with $b,
857 # because all of their data must be kept in sync
858 my @thisbugmergelist= split(/ /,$data->{mergedwith});
861 foreach $ref (@thisbugmergelist) {
863 push @okayblockers, $ref;
870 push @badblockers, $ref;
874 push @badblockers, $b;
878 print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
884 if ($data->{blockedby} eq '') {
885 print {$transcript} "Was not blocked by any bugs.\n";
887 print {$transcript} "Was blocked by: $data->{blockedby}\n";
889 if ($addsub eq "set") {
890 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
891 } elsif ($addsub eq "add") {
892 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
893 } elsif ($addsub eq "sub") {
894 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
899 $affected_packages{$data->{package}} = 1;
900 add_recipients(data => $data, recipients => \%recipients);
901 my @oldblockerlist = split ' ', $data->{blockedby};
902 $data->{blockedby} = '' if ($addsub eq "set");
903 foreach my $b (@okayblockers) {
904 $data->{blockedby} = manipset($data->{blockedby}, $b,
908 foreach my $b (@oldblockerlist) {
909 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
910 push @{$removedblocks{$b}}, $ref;
913 foreach my $b (split ' ', $data->{blockedby}) {
914 if (! grep { $_ eq $b } @oldblockerlist) {
915 push @{$addedblocks{$b}}, $ref;
918 } while (&getnextbug);
920 # Now that the blockedby data is updated, change blocks data
921 # to match the changes.
922 foreach $ref (keys %addedblocks) {
924 foreach my $b (@{$addedblocks{$ref}}) {
925 $data->{blocks} = manipset($data->{blocks}, $b, 1);
930 foreach $ref (keys %removedblocks) {
932 foreach my $b (@{$removedblocks{$ref}}) {
933 $data->{blocks} = manipset($data->{blocks}, $b, 0);
939 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
941 $ref= $1; my $newtitle= $2;
942 $bug_affected{$ref}=1;
943 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
944 $ref = $clonebugs{$ref};
947 if (&checkpkglimit) {
949 $affected_packages{$data->{package}} = 1;
950 add_recipients(data => $data, recipients => \%recipients);
951 my $oldtitle = $data->{subject};
952 $data->{subject}= $newtitle;
953 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
955 print {$transcript} "$action\n";
956 if (length($data->{done})) {
957 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
959 print {$transcript} "\n";
966 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
969 $bug_affected{$ref} = 1;
971 if (!length($data->{mergedwith})) {
972 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
975 $mergelowstate eq 'locked' || die "$mergelowstate ?";
976 $action= "Disconnected #$ref from all other report(s).";
977 my @newmergelist= split(/ /,$data->{mergedwith});
979 @bug_affected{@newmergelist} = 1 x @newmergelist;
981 $affected_packages{$data->{package}} = 1;
982 add_recipients(data => $data, recipients => \%recipients);
983 $data->{mergedwith}= ($ref == $discref) ? ''
984 : join(' ',grep($_ ne $ref,@newmergelist));
985 } while (&getnextbug);
988 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
990 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
991 my @newmergelist= ();
996 while (defined($ref= shift(@tomerge))) {
997 print {$transcript} "D| checking merge $ref\n" if $dl;
999 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1000 $ref = $clonebugs{$ref};
1002 next if grep($_ == $ref,@newmergelist);
1003 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1004 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1006 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1008 &checkmatch('package','m_package',$data->{package},@newmergelist);
1009 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
1010 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
1011 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
1012 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
1013 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
1014 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
1015 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
1016 &checkmatch('summary','m_summary',$data->{summary},@newmergelist);
1017 &checkmatch('affects','m_affects',$data->{affects},@newmergelist);
1018 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
1019 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
1020 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
1021 if (length($mismatch)) {
1022 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
1025 &cancelbug; @newmergelist=(); last;
1027 push(@newmergelist,$ref);
1028 push(@tomerge,split(/ /,$data->{mergedwith}));
1031 if (@newmergelist) {
1032 @newmergelist= sort { $a <=> $b } @newmergelist;
1033 $action= "Merged @newmergelist.";
1034 delete @fixed{keys %found};
1035 for $ref (@newmergelist) {
1036 &getbug || die "huh ? $gBug $ref disappeared during merge";
1037 $affected_packages{$data->{package}} = 1;
1038 add_recipients(data => $data, recipients => \%recipients);
1039 @bug_affected{@newmergelist} = 1 x @newmergelist;
1040 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1041 $data->{keywords}= join(' ', keys %tags);
1042 $data->{found_versions}= [sort keys %found];
1043 $data->{fixed_versions}= [sort keys %fixed];
1046 print {$transcript} "$action\n\n";
1049 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1051 my @temp = split /\s+\#?/,$1;
1052 my $master_bug = shift @temp;
1053 my $master_bug_data;
1054 my @tomerge = sort { $a <=> $b } @temp;
1055 unshift @tomerge,$master_bug;
1056 print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1057 my @newmergelist= ();
1061 # Here we try to do the right thing.
1062 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1063 # If not, we discard the found and fixed.
1064 # Everything else we set to the values of the first bug.
1066 while (defined($ref= shift(@tomerge))) {
1067 print {$transcript} "D| checking merge $ref\n" if $dl;
1069 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1070 $ref = $clonebugs{$ref};
1072 next if grep($_ == $ref,@newmergelist);
1073 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1074 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1076 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1077 $master_bug_data = $data if not defined $master_bug_data;
1078 if ($data->{package} ne $master_bug_data->{package}) {
1079 print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1080 "$gBug $ref is not in the same package as $master_bug\n";
1082 &cancelbug; @newmergelist=(); last;
1084 for my $t (split /\s+/,$data->{keywords}) {
1087 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1088 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1089 push(@newmergelist,$ref);
1090 push(@tomerge,split(/ /,$data->{mergedwith}));
1093 if (@newmergelist) {
1094 @newmergelist= sort { $a <=> $b } @newmergelist;
1095 $action= "Forcibly Merged @newmergelist.";
1096 delete @fixed{keys %found};
1097 for $ref (@newmergelist) {
1098 &getbug || die "huh ? $gBug $ref disappeared during merge";
1099 $affected_packages{$data->{package}} = 1;
1100 add_recipients(data => $data, recipients => \%recipients);
1101 @bug_affected{@newmergelist} = 1 x @newmergelist;
1102 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1103 $data->{keywords}= join(' ', keys %tags);
1104 $data->{found_versions}= [sort keys %found];
1105 $data->{fixed_versions}= [sort keys %fixed];
1106 my @field_list = qw(forwarded package severity blocks blockedby owner done affects summary);
1107 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1110 print {$transcript} "$action\n\n";
1113 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1117 my @newclonedids = split /\s+/, $2;
1118 my $newbugsneeded = scalar(@newclonedids);
1121 $bug_affected{$ref} = 1;
1123 $affected_packages{$data->{package}} = 1;
1124 if (length($data->{mergedwith})) {
1125 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1129 &filelock("nextnumber.lock");
1130 open(N,"nextnumber") || die "nextnumber: read: $!";
1131 my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1132 my $firstref= $v+0; $v += $newbugsneeded;
1133 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1136 my $lastref = $firstref + $newbugsneeded - 1;
1138 if ($newbugsneeded == 1) {
1139 $action= "$gBug $origref cloned as bug $firstref.";
1141 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1144 my $blocks = $data->{blocks};
1145 my $blockedby = $data->{blockedby};
1148 my $ohash = get_hashname($origref);
1149 my $clone = $firstref;
1150 @bug_affected{@newclonedids} = 1 x @newclonedids;
1151 for my $newclonedid (@newclonedids) {
1152 $clonebugs{$newclonedid} = $clone;
1154 my $hash = get_hashname($clone);
1155 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1156 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1157 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1158 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1159 &bughook('new', $clone, $data);
1161 # Update blocking info of bugs blocked by or blocking the
1163 foreach $ref (split ' ', $blocks) {
1165 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1168 foreach $ref (split ' ', $blockedby) {
1170 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1178 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1180 my @pkgs = split /\s+/, $1;
1181 if (scalar(@pkgs) > 0) {
1182 %limit_pkgs = map { ($_, 1) } @pkgs;
1183 print {$transcript} "Ignoring bugs not assigned to: " .
1184 join(" ", keys(%limit_pkgs)) . "\n\n";
1187 print {$transcript} "Not ignoring any bugs.\n\n";
1189 } elsif (m/^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/i) {
1192 my $add_remove = $2 || '';
1193 my $packages = $3 || '';
1194 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1195 $bug_affected{$ref} = 1;
1197 affects(bug => $ref,
1198 transcript => $transcript,
1199 ($dl > 0 ? (debug => $transcript):()),
1200 requester => $header{from},
1201 request_addr => $controlrequestaddr,
1203 recipients => \%recipients,
1204 packages => [splitpackages($3)],
1205 ($add_remove eq '+'?(add => 1):()),
1206 ($add_remove eq '-'?(remove => 1):()),
1211 print {$transcript} "Failed to give $ref a summary: $@";
1214 } elsif (m/^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/i) {
1217 my $summary_msg = length($2)?$2:undef;
1218 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1219 $bug_affected{$ref} = 1;
1221 summary(bug => $ref,
1222 transcript => $transcript,
1223 ($dl > 0 ? (debug => $transcript):()),
1224 requester => $header{from},
1225 request_addr => $controlrequestaddr,
1227 recipients => \%recipients,
1228 summary => $summary_msg,
1233 print {$transcript} "Failed to give $ref a summary: $@";
1236 } elsif (m/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) {
1239 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1241 if ($newowner eq '!') {
1242 $newowner = $replyto;
1244 $bug_affected{$ref} = 1;
1247 transcript => $transcript,
1248 ($dl > 0 ? (debug => $transcript):()),
1249 requester => $header{from},
1250 request_addr => $controlrequestaddr,
1252 recipients => \%recipients,
1258 print {$transcript} "Failed to mark $ref as having an owner: $@";
1260 } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) {
1263 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1264 $bug_affected{$ref} = 1;
1267 transcript => $transcript,
1268 ($dl > 0 ? (debug => $transcript):()),
1269 requester => $header{from},
1270 request_addr => $controlrequestaddr,
1272 recipients => \%recipients,
1278 print {$transcript} "Failed to mark $ref as not having an owner: $@";
1280 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1283 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1284 $bug_affected{$ref} = 1;
1286 bug_unarchive(bug => $ref,
1287 transcript => $transcript,
1288 ($dl > 0 ? (debug => $transcript):()),
1289 affected_bugs => \%bug_affected,
1290 requester => $header{from},
1291 request_addr => $controlrequestaddr,
1293 recipients => \%recipients,
1299 } elsif (m/^archive\s+#?(\d+)$/i) {
1302 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1303 $bug_affected{$ref} = 1;
1305 bug_archive(bug => $ref,
1306 transcript => $transcript,
1307 ($dl > 0 ? (debug => $transcript):()),
1309 archive_unarchived => 0,
1310 affected_bugs => \%bug_affected,
1311 requester => $header{from},
1312 request_addr => $controlrequestaddr,
1314 recipients => \%recipients,
1321 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1323 if (++$unknowns >= 5) {
1324 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1329 if ($procline>$#bodylines) {
1330 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1332 if (!$ok && !$quickabort) {
1334 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1336 print {$transcript} "\n";
1339 my @maintccs = determine_recipients(recipients => \%recipients,
1343 my $maintccs = 'Cc: '.join(",\n ",
1344 determine_recipients(recipients => \%recipients,
1350 $packagepr = "X-${gProject}-PR-Package: " . join(keys %affected_packages) . "\n" if keys %affected_packages;
1352 # Add Bcc's to subscribed bugs
1353 # now handled by Debbugs::Recipients
1354 #push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1356 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1357 $header{'subject'} = "your mail";
1360 # Error text here advertises how many errors there were
1361 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1364 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1366 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1367 In-Reply-To: $header{'message-id'}
1370 References: $header{'message-id'}
1371 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1373 ${packagepr}X-$gProject-PR-Message: transcript
1375 ${transcript_scalar}Please contact me if you need assistance.
1378 (administrator, $gProject $gBugs database)
1381 my $repliedshow= join(', ',$replyto,
1382 determine_recipients(recipients => \%recipients,
1387 # -1 is the service.in log
1388 &filelock("lock/-1");
1389 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1391 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1393 "<strong>Request received</strong> from <code>".
1394 html_escape($header{'from'})."</code>\n".
1395 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1397 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1398 close(AP) || die "open db-h/-1.log: $!";
1400 utime(time,time,"db-h");
1402 &sendmailmessage($reply,
1403 exists $header{'x-debbugs-no-ack'}?():$replyto,
1404 make_list(values %{{determine_recipients(recipients => \%recipients,
1410 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1412 sub sendmailmessage {
1413 my ($message,@recips) = @_;
1414 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1415 send_mail_message(message => $message,
1416 recipients => \@recips,
1422 my ($template,$extra_var) = @_;
1424 my $variables = {config => \%config,
1425 defined($ref)?(ref => $ref):(),
1426 defined($data)?(data => $data):(),
1429 my $hole_var = {'&bugurl' =>
1431 'http://'.$config{cgi_domain}.'/'.
1432 Debbugs::CGI::bug_url($_[0]);
1435 return fill_in_template(template => $template,
1436 variables => $variables,
1437 hole_var => $hole_var,
1441 =head2 message_body_template
1443 message_body_template('mail/ack',{ref=>'foo'});
1445 Creates a message body using a template
1449 sub message_body_template{
1450 my ($template,$extra_var) = @_;
1452 my $body = fill_template($template,$extra_var);
1453 return fill_template('mail/message_body',
1461 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1462 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1466 #sub unimplemented {
1467 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1469 our %checkmatch_values;
1471 my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1473 if (@newmergelist) {
1474 $mvarvalue = $checkmatch_values{$mvarname};
1475 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1478 "Values for \`$string' don't match:\n".
1479 " #$newmergelist[0] has \`$mvarvalue';\n".
1480 " #$ref has \`$svarvalue'\n"
1481 if $mvarvalue ne $svarvalue;
1483 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1485 $checkmatch_values{$mvarname} = $svarvalue;
1490 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1491 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1503 my %h = map { $_ => 1 } split ' ', $list;
1510 return join ' ', sort keys %h;
1513 # High-level bug manipulation calls
1514 # Do announcements themselves
1516 # Possible calling sequences:
1517 # setbug (returns 0)
1519 # setbug (returns 1)
1520 # &transcript(something)
1523 # setbug (returns 1)
1524 # $action= (something)
1526 # (modify s_* variables)
1527 # } while (getnextbug);
1532 &dlen("nochangebug");
1533 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1535 &endmerge if $manybugs;
1537 &dlex("nochangebug");
1541 our @thisbugmergelist;
1544 &dlen("setbug $ref");
1545 if ($ref =~ m/^-\d+/) {
1546 if (!defined $clonebugs{$ref}) {
1548 &dlex("setbug => noclone");
1551 $ref = $clonebugs{$ref};
1553 $state eq 'idle' || die "$state ?";
1556 &dlex("setbug => 0s");
1560 if (!&checkpkglimit) {
1565 @thisbugmergelist= split(/ /,$data->{mergedwith});
1566 if (!@thisbugmergelist) {
1571 &dlex("setbug => 1s");
1580 &dlex("setbug => 0mc");
1584 $state= 'multiple'; $sref=$ref;
1585 &dlex("setbug => 1m");
1590 &dlen("getnextbug");
1591 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1593 if (!$manybugs || !@thisbugmergelist) {
1594 length($action) || die;
1595 print {$transcript} "$action\n$extramessage\n";
1596 &endmerge if $manybugs;
1598 &dlex("getnextbug => 0");
1601 $ref= shift(@thisbugmergelist);
1602 &getbug || die "bug $ref disappeared";
1604 &dlex("getnextbug => 1");
1608 # Low-level bug-manipulation calls
1609 # Do no announcements
1611 # getbug (returns 0)
1613 # getbug (returns 1)
1617 # $action= (something)
1618 # getbug (returns 1)
1620 # getbug (returns 1)
1622 # [getbug (returns 0)]
1623 # &transcript("$action\n\n")
1626 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1627 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1631 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1632 &filelock('lock/merge');
1633 $mergelowstate='locked';
1639 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1641 $mergelowstate='idle';
1646 &dlen("getbug $ref");
1647 $lowstate eq 'idle' || die "$state ?";
1648 # Only use unmerged bugs here
1649 if (($data = &lockreadbug($ref,'db-h'))) {
1652 &dlex("getbug => 1");
1657 &dlex("getbug => 0");
1663 $lowstate eq 'open' || die "$state ?";
1670 &dlen("savebug $ref");
1671 $lowstate eq 'open' || die "$lowstate ?";
1672 length($action) || die;
1673 $ref == $sref || die "read $sref but saving $ref ?";
1674 append_action_to_log(bug => $ref,
1676 requester => $header{from},
1677 request_addr => $controlrequestaddr,
1681 unlockwritebug($ref, $data);
1688 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1693 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1700 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1701 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1707 print {$transcript} "\n";
1713 print {$transcript} "\n";
1719 sub sendtxthelpraw {
1720 my ($relpath,$description) = @_;
1722 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1723 while(<D>) { $doc.=$_; }
1725 print {$transcript} "Sending $description in separate message.\n";
1726 &sendmailmessage(<<END.$doc,$replyto);
1727 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1729 Subject: $gProject $gBug help: $description
1730 References: $header{'message-id'}
1731 In-Reply-To: $header{'message-id'}
1732 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1734 X-$gProject-PR-Message: doc-text $relpath
1740 sub sendlynxdocraw {
1741 my ($relpath,$description) = @_;
1743 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1744 while(<L>) { $doc.=$_; }
1746 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1747 print {$transcript} "Information ($description) is not available -\n".
1748 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1751 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1753 print {$transcript} "Sending $description.\n";
1754 &sendmailmessage(<<END.$doc,$replyto);
1755 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1757 Subject: $gProject $gBugs information: $description
1758 References: $header{'message-id'}
1759 In-Reply-To: $header{'message-id'}
1760 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1762 X-$gProject-PR-Message: doc-html $relpath
1771 my ($wherefrom,$path,$description) = @_;
1772 if ($wherefrom eq "ftp.d.o") {
1773 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1775 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1776 print {$transcript} "$description is not available.\n";
1779 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1782 } elsif ($wherefrom eq "local") {
1784 $doc = do { local $/; <P> };
1787 print {$transcript} "internal errror: info files location unknown.\n";
1790 print {$transcript} "Sending $description.\n";
1791 &sendmailmessage(<<END.$doc,$replyto);
1792 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1794 Subject: $gProject $gBugs information: $description
1795 References: $header{'message-id'}
1796 In-Reply-To: $header{'message-id'}
1797 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1799 X-$gProject-PR-Message: getinfo
1801 $description follows:
1805 print {$transcript} "\n";