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 :hook);
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},
456 transcript => $transcript,
457 ($dl > 0 ? (debug => $transcript):()),
459 $data->{done}= $replyto;
460 my @keywords= split ' ', $data->{keywords};
461 my $extramessage = '';
462 if (grep $_ eq 'pending', @keywords) {
463 $extramessage= "Removed pending tag.\n";
464 $data->{keywords}= join ' ', grep $_ ne 'pending',
467 addfixedversions($data, $data->{package}, $version, 'binary');
470 From: $gMaintainerEmail ($gProject $gBug Tracking System)
471 To: $data->{originator}
472 Subject: $gBug#$ref acknowledged by developer
474 References: $header{'message-id'} $data->{msgid}
475 In-Reply-To: $data->{msgid}
476 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
477 Reply-To: $ref\@$gEmailDomain
478 X-$gProject-PR-Message: they-closed-control $ref
480 This is an automatic notification regarding your $gBug report
481 #$ref: $data->{subject},
482 which was filed against the $data->{package} package.
484 It has been marked as closed by one of the developers, namely
487 You should be hearing from them with a substantive response shortly,
488 in case you haven't already. If not, please contact them directly.
491 (administrator, $gProject $gBugs database)
494 &sendmailmessage($message,$data->{originator});
495 } while (&getnextbug);
498 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
502 $bug_affected{$ref}=1;
504 $newpackage =~ y/A-Z/a-z/;
506 if (length($data->{package})) {
507 $action= "$gBug reassigned from package \`$data->{package}'".
508 " to \`$newpackage'.";
510 $action= "$gBug assigned to package \`$newpackage'.";
513 $affected_packages{$data->{package}} = 1;
514 add_recipients(data => $data,
515 recipients => \%recipients,
516 transcript => $transcript,
517 ($dl > 0 ? (debug => $transcript):()),
519 $data->{package}= $newpackage;
520 $data->{found_versions}= [];
521 $data->{fixed_versions}= [];
522 # TODO: what if $newpackage is a source package?
523 addfoundversions($data, $data->{package}, $version, 'binary');
524 add_recipients(data => $data,
525 recipients => \%recipients,
526 transcript => $transcript,
527 ($dl > 0 ? (debug => $transcript):()),
529 } while (&getnextbug);
531 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
532 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
533 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
534 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
537 $bug_affected{$ref}=1;
539 if (@{$data->{fixed_versions}}) {
540 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";
542 if (!length($data->{done})) {
543 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
547 $noriginator eq '' ? "$gBug reopened, originator not changed." :
548 "$gBug reopened, originator set to $noriginator.";
550 $affected_packages{$data->{package}} = 1;
551 add_recipients(data => $data,
552 recipients => \%recipients,
553 transcript => $transcript,
554 ($dl > 0 ? (debug => $transcript):()),
556 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
557 $data->{fixed_versions}= [];
559 } while (&getnextbug);
562 } elsif (m{^found\s+\#?(-?\d+)
563 (?:\s+((?:$config{package_name_re}\/)?
564 $config{package_version_re}))?$}ix) {
569 if (!length($data->{done}) and not defined($version)) {
570 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
576 "$gBug marked as found in version $version." :
579 $affected_packages{$data->{package}} = 1;
580 add_recipients(data => $data,
581 recipients => \%recipients,
582 transcript => $transcript,
583 ($dl > 0 ? (debug => $transcript):()),
585 # The 'done' field gets a bit weird with version
586 # tracking, because a bug may be closed by multiple
587 # people in different branches. Until we have something
588 # more flexible, we set it every time a bug is fixed,
589 # and clear it when a bug is found in a version greater
590 # than any version in which the bug is fixed or when
591 # a bug is found and there is no fixed version
592 if (defined $version) {
593 my ($version_only) = $version =~ m{([^/]+)$};
594 addfoundversions($data, $data->{package}, $version, 'binary');
595 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
596 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
597 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
598 $action = "$gBug marked as found in version $version and reopened."
599 if length $data->{done};
603 # Versionless found; assume old-style "not fixed at
605 $data->{fixed_versions} = [];
608 } while (&getnextbug);
611 } elsif (m[^notfound\s+\#?(-?\d+)\s+
612 ((?:$config{package_name_re}\/)?
618 $action= "$gBug no longer marked as found in version $version.";
619 if (length($data->{done})) {
620 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
623 $affected_packages{$data->{package}} = 1;
624 add_recipients(data => $data,
625 recipients => \%recipients,
626 transcript => $transcript,
627 ($dl > 0 ? (debug => $transcript):()),
629 removefoundversions($data, $data->{package}, $version, 'binary');
630 } while (&getnextbug);
633 elsif (m[^fixed\s+\#?(-?\d+)\s+
634 ((?:$config{package_name_re}\/)?
635 $config{package_version_re})\s*$]ix) {
642 "$gBug marked as fixed in version $version." :
645 $affected_packages{$data->{package}} = 1;
646 add_recipients(data => $data,
647 recipients => \%recipients,
648 transcript => $transcript,
649 ($dl > 0 ? (debug => $transcript):()),
651 addfixedversions($data, $data->{package}, $version, 'binary');
652 } while (&getnextbug);
655 elsif (m[^notfixed\s+\#?(-?\d+)\s+
656 ((?:$config{package_name_re}\/)?
664 "$gBug no longer marked as fixed in version $version." :
667 $affected_packages{$data->{package}} = 1;
668 add_recipients(data => $data,
669 recipients => \%recipients,
670 transcript => $transcript,
671 ($dl > 0 ? (debug => $transcript):()),
673 removefixedversions($data, $data->{package}, $version, 'binary');
674 } while (&getnextbug);
677 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
678 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
681 $bug_affected{$ref}=1;
682 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
683 $ref = $clonebugs{$ref};
685 if (not Mail::RFC822::Address::valid($newsubmitter)) {
686 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
690 if (&checkpkglimit) {
692 $affected_packages{$data->{package}} = 1;
693 add_recipients(data => $data,
694 recipients => \%recipients,
695 transcript => $transcript,
696 ($dl > 0 ? (debug => $transcript):()),
698 $oldsubmitter= $data->{originator};
699 $data->{originator}= $newsubmitter;
700 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
702 print {$transcript} "$action\n";
703 if (length($data->{done})) {
704 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
706 print {$transcript} "\n";
708 From: $gMaintainerEmail ($gProject $gBug Tracking System)
710 Subject: $gBug#$ref submitter address changed
712 References: $header{'message-id'} $data->{msgid}
713 In-Reply-To: $data->{msgid}
714 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
715 Reply-To: $ref\@$gEmailDomain
716 X-$gProject-PR-Message: submitter-changed $ref
718 The submitter address recorded for your $gBug report
719 #$ref: $data->{subject}
722 The old submitter address for this report was
724 The new submitter address is
727 This change was made by
729 If it was incorrect, please contact them directly.
732 (administrator, $gProject $gBugs database)
735 &sendmailmessage($message,$oldsubmitter);
742 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
746 $bug_affected{$ref}=1;
748 if (length($data->{forwarded})) {
749 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
751 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
753 if (length($data->{done})) {
754 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
757 $affected_packages{$data->{package}} = 1;
758 add_recipients(data => $data,
759 recipients => \%recipients,
760 actions_taken => {forwarded => 1},
761 transcript => $transcript,
762 ($dl > 0 ? (debug => $transcript):()),
764 $data->{forwarded}= $whereto;
765 } while (&getnextbug);
767 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
770 $bug_affected{$ref}=1;
772 if (!length($data->{forwarded})) {
773 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
776 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
778 $affected_packages{$data->{package}} = 1;
779 add_recipients(data => $data,
780 recipients => \%recipients.
781 transcript => $transcript,
782 ($dl > 0 ? (debug => $transcript):()),
784 $data->{forwarded}= '';
785 } while (&getnextbug);
788 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
789 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
792 $bug_affected{$ref}=1;
794 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
795 print {$transcript} "Severity level \`$newseverity' is not known.\n".
796 "Recognized are: $gShowSeverities.\n\n";
798 } elsif (exists $gObsoleteSeverities{$newseverity}) {
799 print {$transcript} "Severity level \`$newseverity' is obsolete. " .
800 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
803 my $printseverity= $data->{severity};
804 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
805 $action= "Severity set to \`$newseverity' from \`$printseverity'";
807 $affected_packages{$data->{package}} = 1;
808 add_recipients(data => $data,
809 recipients => \%recipients,
810 transcript => $transcript,
811 ($dl > 0 ? (debug => $transcript):()),
813 if (defined $gStrongList and isstrongseverity($newseverity)) {
814 addbcc("$gStrongList\@$gListDomain");
816 $data->{severity}= $newseverity;
817 } while (&getnextbug);
819 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
824 $bug_affected{$ref}=1;
826 if (defined $addsubcode) {
827 $addsub = "sub" if ($addsubcode eq "-");
828 $addsub = "add" if ($addsubcode eq "+");
829 $addsub = "set" if ($addsubcode eq "=");
833 foreach my $t (split /[\s,]+/, $tags) {
834 if (!grep($_ eq $t, @gTags)) {
841 print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
842 "Recognized are: ".join(' ', @gTags).".\n\n";
846 if ($data->{keywords} eq '') {
847 print {$transcript} "There were no tags set.\n";
849 print {$transcript} "Tags were: $data->{keywords}\n";
851 if ($addsub eq "set") {
852 $action= "Tags set to: " . join(", ", @okaytags);
853 } elsif ($addsub eq "add") {
854 $action= "Tags added: " . join(", ", @okaytags);
855 } elsif ($addsub eq "sub") {
856 $action= "Tags removed: " . join(", ", @okaytags);
859 $affected_packages{$data->{package}} = 1;
860 add_recipients(data => $data,
861 recipients => \%recipients,
862 transcript => $transcript,
863 ($dl > 0 ? (debug => $transcript):()),
865 $data->{keywords} = '' if ($addsub eq "set");
866 # Allow removing obsolete tags.
867 if ($addsub eq "sub") {
868 foreach my $t (@badtags) {
869 $data->{keywords} = join ' ', grep $_ ne $t,
870 split ' ', $data->{keywords};
873 # Now process all other additions and subtractions.
874 foreach my $t (@okaytags) {
875 $data->{keywords} = join ' ', grep $_ ne $t,
876 split ' ', $data->{keywords};
877 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
879 $data->{keywords} =~ s/\s*$//;
880 } while (&getnextbug);
882 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
884 my $bugnum = $2; my $blockers = $4;
886 $addsub = "sub" if (defined $1 and $1 eq "un");
887 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
888 $bugnum = $clonebugs{$bugnum};
893 foreach my $b (split /[\s,]+/, $blockers) {
897 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
898 $ref = $clonebugs{$ref};
902 push @okayblockers, $ref;
904 # add to the list all bugs that are merged with $b,
905 # because all of their data must be kept in sync
906 my @thisbugmergelist= split(/ /,$data->{mergedwith});
909 foreach $ref (@thisbugmergelist) {
911 push @okayblockers, $ref;
918 push @badblockers, $ref;
922 push @badblockers, $b;
926 print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
932 if ($data->{blockedby} eq '') {
933 print {$transcript} "Was not blocked by any bugs.\n";
935 print {$transcript} "Was blocked by: $data->{blockedby}\n";
937 if ($addsub eq "set") {
938 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
939 } elsif ($addsub eq "add") {
940 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
941 } elsif ($addsub eq "sub") {
942 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
947 $affected_packages{$data->{package}} = 1;
948 add_recipients(data => $data,
949 recipients => \%recipients,
950 transcript => $transcript,
951 ($dl > 0 ? (debug => $transcript):()),
953 my @oldblockerlist = split ' ', $data->{blockedby};
954 $data->{blockedby} = '' if ($addsub eq "set");
955 foreach my $b (@okayblockers) {
956 $data->{blockedby} = manipset($data->{blockedby}, $b,
960 foreach my $b (@oldblockerlist) {
961 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
962 push @{$removedblocks{$b}}, $ref;
965 foreach my $b (split ' ', $data->{blockedby}) {
966 if (! grep { $_ eq $b } @oldblockerlist) {
967 push @{$addedblocks{$b}}, $ref;
970 } while (&getnextbug);
972 # Now that the blockedby data is updated, change blocks data
973 # to match the changes.
974 foreach $ref (keys %addedblocks) {
976 foreach my $b (@{$addedblocks{$ref}}) {
977 $data->{blocks} = manipset($data->{blocks}, $b, 1);
982 foreach $ref (keys %removedblocks) {
984 foreach my $b (@{$removedblocks{$ref}}) {
985 $data->{blocks} = manipset($data->{blocks}, $b, 0);
991 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
993 $ref= $1; my $newtitle= $2;
994 $bug_affected{$ref}=1;
995 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
996 $ref = $clonebugs{$ref};
999 if (&checkpkglimit) {
1001 $affected_packages{$data->{package}} = 1;
1002 add_recipients(data => $data,
1003 recipients => \%recipients,
1004 transcript => $transcript,
1005 ($dl > 0 ? (debug => $transcript):()),
1007 my $oldtitle = $data->{subject};
1008 $data->{subject}= $newtitle;
1009 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
1011 print {$transcript} "$action\n";
1012 if (length($data->{done})) {
1013 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
1015 print {$transcript} "\n";
1022 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
1025 $bug_affected{$ref} = 1;
1027 if (!length($data->{mergedwith})) {
1028 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
1031 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1032 $action= "Disconnected #$ref from all other report(s).";
1033 my @newmergelist= split(/ /,$data->{mergedwith});
1035 @bug_affected{@newmergelist} = 1 x @newmergelist;
1037 $affected_packages{$data->{package}} = 1;
1038 add_recipients(data => $data,
1039 recipients => \%recipients,
1040 transcript => $transcript,
1041 ($dl > 0 ? (debug => $transcript):()),
1043 $data->{mergedwith}= ($ref == $discref) ? ''
1044 : join(' ',grep($_ ne $ref,@newmergelist));
1045 } while (&getnextbug);
1048 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
1050 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
1051 my @newmergelist= ();
1056 while (defined($ref= shift(@tomerge))) {
1057 print {$transcript} "D| checking merge $ref\n" if $dl;
1059 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1060 $ref = $clonebugs{$ref};
1062 next if grep($_ == $ref,@newmergelist);
1063 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1064 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1066 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1068 &checkmatch('package','m_package',$data->{package},@newmergelist);
1069 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
1070 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
1071 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
1072 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
1073 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
1074 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
1075 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
1076 &checkmatch('summary','m_summary',$data->{summary},@newmergelist);
1077 &checkmatch('affects','m_affects',$data->{affects},@newmergelist);
1078 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
1079 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
1080 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
1081 if (length($mismatch)) {
1082 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
1085 &cancelbug; @newmergelist=(); last;
1087 push(@newmergelist,$ref);
1088 push(@tomerge,split(/ /,$data->{mergedwith}));
1091 if (@newmergelist) {
1092 @newmergelist= sort { $a <=> $b } @newmergelist;
1093 $action= "Merged @newmergelist.";
1094 delete @fixed{keys %found};
1095 for $ref (@newmergelist) {
1096 &getbug || die "huh ? $gBug $ref disappeared during merge";
1097 $affected_packages{$data->{package}} = 1;
1098 add_recipients(data => $data,
1099 recipients => \%recipients,
1100 transcript => $transcript,
1101 ($dl > 0 ? (debug => $transcript):()),
1103 @bug_affected{@newmergelist} = 1 x @newmergelist;
1104 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1105 $data->{keywords}= join(' ', keys %tags);
1106 $data->{found_versions}= [sort keys %found];
1107 $data->{fixed_versions}= [sort keys %fixed];
1110 print {$transcript} "$action\n\n";
1113 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1115 my @temp = split /\s+\#?/,$1;
1116 my $master_bug = shift @temp;
1117 my $master_bug_data;
1118 my @tomerge = sort { $a <=> $b } @temp;
1119 unshift @tomerge,$master_bug;
1120 print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1121 my @newmergelist= ();
1125 # Here we try to do the right thing.
1126 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1127 # If not, we discard the found and fixed.
1128 # Everything else we set to the values of the first bug.
1130 while (defined($ref= shift(@tomerge))) {
1131 print {$transcript} "D| checking merge $ref\n" if $dl;
1133 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1134 $ref = $clonebugs{$ref};
1136 next if grep($_ == $ref,@newmergelist);
1137 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1138 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1140 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1141 $master_bug_data = $data if not defined $master_bug_data;
1142 if ($data->{package} ne $master_bug_data->{package}) {
1143 print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1144 "$gBug $ref is not in the same package as $master_bug\n";
1146 &cancelbug; @newmergelist=(); last;
1148 for my $t (split /\s+/,$data->{keywords}) {
1151 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1152 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1153 push(@newmergelist,$ref);
1154 push(@tomerge,split(/ /,$data->{mergedwith}));
1157 if (@newmergelist) {
1158 @newmergelist= sort { $a <=> $b } @newmergelist;
1159 $action= "Forcibly Merged @newmergelist.";
1160 delete @fixed{keys %found};
1161 for $ref (@newmergelist) {
1162 &getbug || die "huh ? $gBug $ref disappeared during merge";
1163 $affected_packages{$data->{package}} = 1;
1164 add_recipients(data => $data,
1165 recipients => \%recipients,
1166 transcript => $transcript,
1167 ($dl > 0 ? (debug => $transcript):()),
1169 @bug_affected{@newmergelist} = 1 x @newmergelist;
1170 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1171 $data->{keywords}= join(' ', keys %tags);
1172 $data->{found_versions}= [sort keys %found];
1173 $data->{fixed_versions}= [sort keys %fixed];
1174 my @field_list = qw(forwarded package severity blocks blockedby owner done affects summary);
1175 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1178 print {$transcript} "$action\n\n";
1181 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1185 my @newclonedids = split /\s+/, $2;
1186 my $newbugsneeded = scalar(@newclonedids);
1189 $bug_affected{$ref} = 1;
1191 $affected_packages{$data->{package}} = 1;
1192 if (length($data->{mergedwith})) {
1193 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1197 &filelock("nextnumber.lock");
1198 open(N,"nextnumber") || die "nextnumber: read: $!";
1199 my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1200 my $firstref= $v+0; $v += $newbugsneeded;
1201 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1204 my $lastref = $firstref + $newbugsneeded - 1;
1206 if ($newbugsneeded == 1) {
1207 $action= "$gBug $origref cloned as bug $firstref.";
1209 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1212 my $blocks = $data->{blocks};
1213 my $blockedby = $data->{blockedby};
1216 my $ohash = get_hashname($origref);
1217 my $clone = $firstref;
1218 @bug_affected{@newclonedids} = 1 x @newclonedids;
1219 for my $newclonedid (@newclonedids) {
1220 $clonebugs{$newclonedid} = $clone;
1222 my $hash = get_hashname($clone);
1223 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1224 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1225 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1226 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1227 &bughook('new', $clone, $data);
1229 # Update blocking info of bugs blocked by or blocking the
1231 foreach $ref (split ' ', $blocks) {
1233 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1236 foreach $ref (split ' ', $blockedby) {
1238 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1246 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1248 my @pkgs = split /\s+/, $1;
1249 if (scalar(@pkgs) > 0) {
1250 %limit_pkgs = map { ($_, 1) } @pkgs;
1251 print {$transcript} "Ignoring bugs not assigned to: " .
1252 join(" ", keys(%limit_pkgs)) . "\n\n";
1255 print {$transcript} "Not ignoring any bugs.\n\n";
1257 } elsif (m/^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/i) {
1260 my $add_remove = $2 || '';
1261 my $packages = $3 || '';
1262 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1263 $bug_affected{$ref} = 1;
1265 affects(bug => $ref,
1266 transcript => $transcript,
1267 ($dl > 0 ? (debug => $transcript):()),
1268 requester => $header{from},
1269 request_addr => $controlrequestaddr,
1271 recipients => \%recipients,
1272 packages => [splitpackages($3)],
1273 ($add_remove eq '+'?(add => 1):()),
1274 ($add_remove eq '-'?(remove => 1):()),
1279 print {$transcript} "Failed to give $ref a summary: $@";
1282 } elsif (m/^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/i) {
1285 my $summary_msg = length($2)?$2:undef;
1286 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1287 $bug_affected{$ref} = 1;
1289 summary(bug => $ref,
1290 transcript => $transcript,
1291 ($dl > 0 ? (debug => $transcript):()),
1292 requester => $header{from},
1293 request_addr => $controlrequestaddr,
1295 recipients => \%recipients,
1296 summary => $summary_msg,
1301 print {$transcript} "Failed to give $ref a summary: $@";
1304 } elsif (m/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) {
1307 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1309 if ($newowner eq '!') {
1310 $newowner = $replyto;
1312 $bug_affected{$ref} = 1;
1315 transcript => $transcript,
1316 ($dl > 0 ? (debug => $transcript):()),
1317 requester => $header{from},
1318 request_addr => $controlrequestaddr,
1320 recipients => \%recipients,
1326 print {$transcript} "Failed to mark $ref as having an owner: $@";
1328 } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) {
1331 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1332 $bug_affected{$ref} = 1;
1335 transcript => $transcript,
1336 ($dl > 0 ? (debug => $transcript):()),
1337 requester => $header{from},
1338 request_addr => $controlrequestaddr,
1340 recipients => \%recipients,
1346 print {$transcript} "Failed to mark $ref as not having an owner: $@";
1348 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1351 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1352 $bug_affected{$ref} = 1;
1354 bug_unarchive(bug => $ref,
1355 transcript => $transcript,
1356 ($dl > 0 ? (debug => $transcript):()),
1357 affected_bugs => \%bug_affected,
1358 requester => $header{from},
1359 request_addr => $controlrequestaddr,
1361 recipients => \%recipients,
1367 } elsif (m/^archive\s+#?(\d+)$/i) {
1370 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1371 $bug_affected{$ref} = 1;
1373 bug_archive(bug => $ref,
1374 transcript => $transcript,
1375 ($dl > 0 ? (debug => $transcript):()),
1377 archive_unarchived => 0,
1378 affected_bugs => \%bug_affected,
1379 requester => $header{from},
1380 request_addr => $controlrequestaddr,
1382 recipients => \%recipients,
1389 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1391 if (++$unknowns >= 5) {
1392 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1397 if ($procline>$#bodylines) {
1398 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1400 if (!$ok && !$quickabort) {
1402 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1404 print {$transcript} "\n";
1407 my @maintccs = determine_recipients(recipients => \%recipients,
1411 my $maintccs = 'Cc: '.join(",\n ",
1412 determine_recipients(recipients => \%recipients,
1418 $packagepr = "X-${gProject}-PR-Package: " . join(keys %affected_packages) . "\n" if keys %affected_packages;
1420 # Add Bcc's to subscribed bugs
1421 # now handled by Debbugs::Recipients
1422 #push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1424 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1425 $header{'subject'} = "your mail";
1428 # Error text here advertises how many errors there were
1429 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1432 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1434 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1435 In-Reply-To: $header{'message-id'}
1438 References: $header{'message-id'}
1439 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1441 ${packagepr}X-$gProject-PR-Message: transcript
1443 ${transcript_scalar}Please contact me if you need assistance.
1446 (administrator, $gProject $gBugs database)
1449 my $repliedshow= join(', ',$replyto,
1450 determine_recipients(recipients => \%recipients,
1455 # -1 is the service.in log
1456 &filelock("lock/-1");
1457 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1459 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1461 "<strong>Request received</strong> from <code>".
1462 html_escape($header{'from'})."</code>\n".
1463 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1465 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1466 close(AP) || die "open db-h/-1.log: $!";
1468 utime(time,time,"db-h");
1470 &sendmailmessage($reply,
1471 exists $header{'x-debbugs-no-ack'}?():$replyto,
1472 make_list(values %{{determine_recipients(recipients => \%recipients,
1478 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1480 sub sendmailmessage {
1481 my ($message,@recips) = @_;
1482 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1483 send_mail_message(message => $message,
1484 recipients => \@recips,
1490 my ($template,$extra_var) = @_;
1492 my $variables = {config => \%config,
1493 defined($ref)?(ref => $ref):(),
1494 defined($data)?(data => $data):(),
1497 my $hole_var = {'&bugurl' =>
1499 'http://'.$config{cgi_domain}.'/'.
1500 Debbugs::CGI::bug_url($_[0]);
1503 return fill_in_template(template => $template,
1504 variables => $variables,
1505 hole_var => $hole_var,
1509 =head2 message_body_template
1511 message_body_template('mail/ack',{ref=>'foo'});
1513 Creates a message body using a template
1517 sub message_body_template{
1518 my ($template,$extra_var) = @_;
1520 my $body = fill_template($template,$extra_var);
1521 return fill_template('mail/message_body',
1529 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1530 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1534 #sub unimplemented {
1535 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1537 our %checkmatch_values;
1539 my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1541 if (@newmergelist) {
1542 $mvarvalue = $checkmatch_values{$mvarname};
1543 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1546 "Values for \`$string' don't match:\n".
1547 " #$newmergelist[0] has \`$mvarvalue';\n".
1548 " #$ref has \`$svarvalue'\n"
1549 if $mvarvalue ne $svarvalue;
1551 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1553 $checkmatch_values{$mvarname} = $svarvalue;
1558 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1559 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1571 my %h = map { $_ => 1 } split ' ', $list;
1578 return join ' ', sort keys %h;
1581 # High-level bug manipulation calls
1582 # Do announcements themselves
1584 # Possible calling sequences:
1585 # setbug (returns 0)
1587 # setbug (returns 1)
1588 # &transcript(something)
1591 # setbug (returns 1)
1592 # $action= (something)
1594 # (modify s_* variables)
1595 # } while (getnextbug);
1600 &dlen("nochangebug");
1601 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1603 &endmerge if $manybugs;
1605 &dlex("nochangebug");
1609 our @thisbugmergelist;
1612 &dlen("setbug $ref");
1613 if ($ref =~ m/^-\d+/) {
1614 if (!defined $clonebugs{$ref}) {
1616 &dlex("setbug => noclone");
1619 $ref = $clonebugs{$ref};
1621 $state eq 'idle' || die "$state ?";
1624 &dlex("setbug => 0s");
1628 if (!&checkpkglimit) {
1633 @thisbugmergelist= split(/ /,$data->{mergedwith});
1634 if (!@thisbugmergelist) {
1639 &dlex("setbug => 1s");
1648 &dlex("setbug => 0mc");
1652 $state= 'multiple'; $sref=$ref;
1653 &dlex("setbug => 1m");
1658 &dlen("getnextbug");
1659 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1661 if (!$manybugs || !@thisbugmergelist) {
1662 length($action) || die;
1663 print {$transcript} "$action\n$extramessage\n";
1664 &endmerge if $manybugs;
1666 &dlex("getnextbug => 0");
1669 $ref= shift(@thisbugmergelist);
1670 &getbug || die "bug $ref disappeared";
1672 &dlex("getnextbug => 1");
1676 # Low-level bug-manipulation calls
1677 # Do no announcements
1679 # getbug (returns 0)
1681 # getbug (returns 1)
1685 # $action= (something)
1686 # getbug (returns 1)
1688 # getbug (returns 1)
1690 # [getbug (returns 0)]
1691 # &transcript("$action\n\n")
1694 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1695 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1699 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1700 &filelock('lock/merge');
1701 $mergelowstate='locked';
1707 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1709 $mergelowstate='idle';
1714 &dlen("getbug $ref");
1715 $lowstate eq 'idle' || die "$state ?";
1716 # Only use unmerged bugs here
1717 if (($data = &lockreadbug($ref,'db-h'))) {
1720 &dlex("getbug => 1");
1725 &dlex("getbug => 0");
1731 $lowstate eq 'open' || die "$state ?";
1738 &dlen("savebug $ref");
1739 $lowstate eq 'open' || die "$lowstate ?";
1740 length($action) || die;
1741 $ref == $sref || die "read $sref but saving $ref ?";
1742 append_action_to_log(bug => $ref,
1744 requester => $header{from},
1745 request_addr => $controlrequestaddr,
1749 unlockwritebug($ref, $data);
1756 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1761 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1768 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1769 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1775 print {$transcript} "\n";
1781 print {$transcript} "\n";
1787 sub sendtxthelpraw {
1788 my ($relpath,$description) = @_;
1790 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1791 while(<D>) { $doc.=$_; }
1793 print {$transcript} "Sending $description in separate message.\n";
1794 &sendmailmessage(<<END.$doc,$replyto);
1795 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1797 Subject: $gProject $gBug help: $description
1798 References: $header{'message-id'}
1799 In-Reply-To: $header{'message-id'}
1800 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1802 X-$gProject-PR-Message: doc-text $relpath
1808 sub sendlynxdocraw {
1809 my ($relpath,$description) = @_;
1811 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1812 while(<L>) { $doc.=$_; }
1814 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1815 print {$transcript} "Information ($description) is not available -\n".
1816 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1819 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1821 print {$transcript} "Sending $description.\n";
1822 &sendmailmessage(<<END.$doc,$replyto);
1823 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1825 Subject: $gProject $gBugs information: $description
1826 References: $header{'message-id'}
1827 In-Reply-To: $header{'message-id'}
1828 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1830 X-$gProject-PR-Message: doc-html $relpath
1839 my ($wherefrom,$path,$description) = @_;
1840 if ($wherefrom eq "ftp.d.o") {
1841 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1843 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1844 print {$transcript} "$description is not available.\n";
1847 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1850 } elsif ($wherefrom eq "local") {
1852 $doc = do { local $/; <P> };
1855 print {$transcript} "internal errror: info files location unknown.\n";
1858 print {$transcript} "Sending $description.\n";
1859 &sendmailmessage(<<END.$doc,$replyto);
1860 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1862 Subject: $gProject $gBugs information: $description
1863 References: $header{'message-id'}
1864 In-Reply-To: $header{'message-id'}
1865 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1867 X-$gProject-PR-Message: getinfo
1869 $description follows:
1873 print {$transcript} "\n";