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 if (defined $tags and length $tags) {
391 for my $t (split /[,\s]+/, $tags) {
392 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
400 print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
403 for my $t (keys %chtags) {
404 $ut{$t} = [] unless defined $ut{$t};
406 for my $t (keys %ut) {
407 my %res = map { ($_, 1) } @{$ut{$t}};
408 push @oldtags, $t if defined $res{$ref};
409 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
410 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
411 : $addsubcode eq "=");
412 $res{$ref} = 1 if ($addop && defined $chtags{$t});
413 delete $res{$ref} if ($del);
414 push @newtags, $t if defined $res{$ref};
415 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
418 print {$transcript} "There were no usertags set.\n";
420 print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
422 print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
423 Debbugs::User::write_usertags(\%ut, $user);
425 } elsif (!$control) {
426 print {$transcript} <<END;
427 Unknown command or malformed arguments to command.
428 (Use control\@$gEmailDomain to manipulate reports.)
432 if (++$unknowns >= 3) {
433 print {$transcript} "Too many unknown commands, stopping here.\n\n";
436 #### "developer only" ones start here
437 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
440 $bug_affected{$ref}=1;
443 print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
444 if (length($data->{done}) and not defined($version)) {
445 print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
450 "marked as fixed in version $version" :
452 ", send any further explanations to $data->{originator}";
454 $affected_packages{$data->{package}} = 1;
455 add_recipients(data => $data,
456 recipients => \%recipients,
457 actions_taken => {done => 1},
458 transcript => $transcript,
459 ($dl > 0 ? (debug => $transcript):()),
461 $data->{done}= $replyto;
462 my @keywords= split ' ', $data->{keywords};
463 my $extramessage = '';
464 if (grep $_ eq 'pending', @keywords) {
465 $extramessage= "Removed pending tag.\n";
466 $data->{keywords}= join ' ', grep $_ ne 'pending',
469 addfixedversions($data, $data->{package}, $version, 'binary');
472 From: $gMaintainerEmail ($gProject $gBug Tracking System)
473 To: $data->{originator}
474 Subject: $gBug#$ref acknowledged by developer
476 References: $header{'message-id'} $data->{msgid}
477 In-Reply-To: $data->{msgid}
478 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
479 Reply-To: $ref\@$gEmailDomain
480 X-$gProject-PR-Message: they-closed-control $ref
482 This is an automatic notification regarding your $gBug report
483 #$ref: $data->{subject},
484 which was filed against the $data->{package} package.
486 It has been marked as closed by one of the developers, namely
489 You should be hearing from them with a substantive response shortly,
490 in case you haven't already. If not, please contact them directly.
493 (administrator, $gProject $gBugs database)
496 &sendmailmessage($message,$data->{originator});
497 } while (&getnextbug);
500 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
504 $bug_affected{$ref}=1;
506 $newpackage =~ y/A-Z/a-z/;
508 if (length($data->{package})) {
509 $action= "$gBug reassigned from package \`$data->{package}'".
510 " to \`$newpackage'.";
512 $action= "$gBug assigned to package \`$newpackage'.";
515 $affected_packages{$data->{package}} = 1;
516 add_recipients(data => $data,
517 recipients => \%recipients,
518 transcript => $transcript,
519 ($dl > 0 ? (debug => $transcript):()),
521 $data->{package}= $newpackage;
522 $data->{found_versions}= [];
523 $data->{fixed_versions}= [];
524 # TODO: what if $newpackage is a source package?
525 addfoundversions($data, $data->{package}, $version, 'binary');
526 add_recipients(data => $data,
527 recipients => \%recipients,
528 transcript => $transcript,
529 ($dl > 0 ? (debug => $transcript):()),
531 } while (&getnextbug);
533 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
534 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
535 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
536 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
539 $bug_affected{$ref}=1;
541 if (@{$data->{fixed_versions}}) {
542 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";
544 if (!length($data->{done})) {
545 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
549 $noriginator eq '' ? "$gBug reopened, originator not changed." :
550 "$gBug reopened, originator set to $noriginator.";
552 $affected_packages{$data->{package}} = 1;
553 add_recipients(data => $data,
554 recipients => \%recipients,
555 transcript => $transcript,
556 ($dl > 0 ? (debug => $transcript):()),
558 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
559 $data->{fixed_versions}= [];
561 } while (&getnextbug);
564 } elsif (m{^found\s+\#?(-?\d+)
565 (?:\s+((?:$config{package_name_re}\/)?
566 $config{package_version_re}))?$}ix) {
571 if (!length($data->{done}) and not defined($version)) {
572 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
578 "$gBug marked as found in version $version." :
581 $affected_packages{$data->{package}} = 1;
582 add_recipients(data => $data,
583 recipients => \%recipients,
584 transcript => $transcript,
585 ($dl > 0 ? (debug => $transcript):()),
587 # The 'done' field gets a bit weird with version
588 # tracking, because a bug may be closed by multiple
589 # people in different branches. Until we have something
590 # more flexible, we set it every time a bug is fixed,
591 # and clear it when a bug is found in a version greater
592 # than any version in which the bug is fixed or when
593 # a bug is found and there is no fixed version
594 if (defined $version) {
595 my ($version_only) = $version =~ m{([^/]+)$};
596 addfoundversions($data, $data->{package}, $version, 'binary');
597 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
598 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
599 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
600 $action = "$gBug marked as found in version $version and reopened."
601 if length $data->{done};
605 # Versionless found; assume old-style "not fixed at
607 $data->{fixed_versions} = [];
610 } while (&getnextbug);
613 } elsif (m[^notfound\s+\#?(-?\d+)\s+
614 ((?:$config{package_name_re}\/)?
620 $action= "$gBug no longer marked as found in version $version.";
621 if (length($data->{done})) {
622 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
625 $affected_packages{$data->{package}} = 1;
626 add_recipients(data => $data,
627 recipients => \%recipients,
628 transcript => $transcript,
629 ($dl > 0 ? (debug => $transcript):()),
631 removefoundversions($data, $data->{package}, $version, 'binary');
632 } while (&getnextbug);
635 elsif (m[^fixed\s+\#?(-?\d+)\s+
636 ((?:$config{package_name_re}\/)?
637 $config{package_version_re})\s*$]ix) {
644 "$gBug marked as fixed in version $version." :
647 $affected_packages{$data->{package}} = 1;
648 add_recipients(data => $data,
649 recipients => \%recipients,
650 transcript => $transcript,
651 ($dl > 0 ? (debug => $transcript):()),
653 addfixedversions($data, $data->{package}, $version, 'binary');
654 } while (&getnextbug);
657 elsif (m[^notfixed\s+\#?(-?\d+)\s+
658 ((?:$config{package_name_re}\/)?
666 "$gBug no longer marked as fixed in version $version." :
669 $affected_packages{$data->{package}} = 1;
670 add_recipients(data => $data,
671 recipients => \%recipients,
672 transcript => $transcript,
673 ($dl > 0 ? (debug => $transcript):()),
675 removefixedversions($data, $data->{package}, $version, 'binary');
676 } while (&getnextbug);
679 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
680 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
683 $bug_affected{$ref}=1;
684 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
685 $ref = $clonebugs{$ref};
687 if (not Mail::RFC822::Address::valid($newsubmitter)) {
688 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
692 if (&checkpkglimit) {
694 $affected_packages{$data->{package}} = 1;
695 add_recipients(data => $data,
696 recipients => \%recipients,
697 transcript => $transcript,
698 ($dl > 0 ? (debug => $transcript):()),
700 $oldsubmitter= $data->{originator};
701 $data->{originator}= $newsubmitter;
702 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
704 print {$transcript} "$action\n";
705 if (length($data->{done})) {
706 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
708 print {$transcript} "\n";
710 From: $gMaintainerEmail ($gProject $gBug Tracking System)
712 Subject: $gBug#$ref submitter address changed
714 References: $header{'message-id'} $data->{msgid}
715 In-Reply-To: $data->{msgid}
716 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
717 Reply-To: $ref\@$gEmailDomain
718 X-$gProject-PR-Message: submitter-changed $ref
720 The submitter address recorded for your $gBug report
721 #$ref: $data->{subject}
724 The old submitter address for this report was
726 The new submitter address is
729 This change was made by
731 If it was incorrect, please contact them directly.
734 (administrator, $gProject $gBugs database)
737 &sendmailmessage($message,$oldsubmitter);
744 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
748 $bug_affected{$ref}=1;
750 if (length($data->{forwarded})) {
751 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
753 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
755 if (length($data->{done})) {
756 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
759 $affected_packages{$data->{package}} = 1;
760 add_recipients(data => $data,
761 recipients => \%recipients,
762 actions_taken => {forwarded => 1},
763 transcript => $transcript,
764 ($dl > 0 ? (debug => $transcript):()),
766 $data->{forwarded}= $whereto;
767 } while (&getnextbug);
769 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
772 $bug_affected{$ref}=1;
774 if (!length($data->{forwarded})) {
775 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
778 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
780 $affected_packages{$data->{package}} = 1;
781 add_recipients(data => $data,
782 recipients => \%recipients,
783 transcript => $transcript,
784 ($dl > 0 ? (debug => $transcript):()),
786 $data->{forwarded}= '';
787 } while (&getnextbug);
790 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
791 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
794 $bug_affected{$ref}=1;
796 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
797 print {$transcript} "Severity level \`$newseverity' is not known.\n".
798 "Recognized are: $gShowSeverities.\n\n";
800 } elsif (exists $gObsoleteSeverities{$newseverity}) {
801 print {$transcript} "Severity level \`$newseverity' is obsolete. " .
802 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
805 my $printseverity= $data->{severity};
806 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
807 $action= "Severity set to \`$newseverity' from \`$printseverity'";
809 $affected_packages{$data->{package}} = 1;
810 add_recipients(data => $data,
811 recipients => \%recipients,
812 transcript => $transcript,
813 ($dl > 0 ? (debug => $transcript):()),
815 if (defined $gStrongList and isstrongseverity($newseverity)) {
816 addbcc("$gStrongList\@$gListDomain");
818 $data->{severity}= $newseverity;
819 } while (&getnextbug);
821 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
826 $bug_affected{$ref}=1;
828 if (defined $addsubcode) {
829 $addsub = "sub" if ($addsubcode eq "-");
830 $addsub = "add" if ($addsubcode eq "+");
831 $addsub = "set" if ($addsubcode eq "=");
835 foreach my $t (split /[\s,]+/, $tags) {
836 if (!grep($_ eq $t, @gTags)) {
843 print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
844 "Recognized are: ".join(' ', @gTags).".\n\n";
848 if ($data->{keywords} eq '') {
849 print {$transcript} "There were no tags set.\n";
851 print {$transcript} "Tags were: $data->{keywords}\n";
853 if ($addsub eq "set") {
854 $action= "Tags set to: " . join(", ", @okaytags);
855 } elsif ($addsub eq "add") {
856 $action= "Tags added: " . join(", ", @okaytags);
857 } elsif ($addsub eq "sub") {
858 $action= "Tags removed: " . join(", ", @okaytags);
861 $affected_packages{$data->{package}} = 1;
862 add_recipients(data => $data,
863 recipients => \%recipients,
864 transcript => $transcript,
865 ($dl > 0 ? (debug => $transcript):()),
867 $data->{keywords} = '' if ($addsub eq "set");
868 # Allow removing obsolete tags.
869 if ($addsub eq "sub") {
870 foreach my $t (@badtags) {
871 $data->{keywords} = join ' ', grep $_ ne $t,
872 split ' ', $data->{keywords};
875 # Now process all other additions and subtractions.
876 foreach my $t (@okaytags) {
877 $data->{keywords} = join ' ', grep $_ ne $t,
878 split ' ', $data->{keywords};
879 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
881 $data->{keywords} =~ s/\s*$//;
882 } while (&getnextbug);
884 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
886 my $bugnum = $2; my $blockers = $4;
888 $addsub = "sub" if (defined $1 and $1 eq "un");
889 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
890 $bugnum = $clonebugs{$bugnum};
895 foreach my $b (split /[\s,]+/, $blockers) {
899 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
900 $ref = $clonebugs{$ref};
904 push @okayblockers, $ref;
906 # add to the list all bugs that are merged with $b,
907 # because all of their data must be kept in sync
908 my @thisbugmergelist= split(/ /,$data->{mergedwith});
911 foreach $ref (@thisbugmergelist) {
913 push @okayblockers, $ref;
920 push @badblockers, $ref;
924 push @badblockers, $b;
928 print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
934 if ($data->{blockedby} eq '') {
935 print {$transcript} "Was not blocked by any bugs.\n";
937 print {$transcript} "Was blocked by: $data->{blockedby}\n";
939 if ($addsub eq "set") {
940 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
941 } elsif ($addsub eq "add") {
942 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
943 } elsif ($addsub eq "sub") {
944 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
949 $affected_packages{$data->{package}} = 1;
950 add_recipients(data => $data,
951 recipients => \%recipients,
952 transcript => $transcript,
953 ($dl > 0 ? (debug => $transcript):()),
955 my @oldblockerlist = split ' ', $data->{blockedby};
956 $data->{blockedby} = '' if ($addsub eq "set");
957 foreach my $b (@okayblockers) {
958 $data->{blockedby} = manipset($data->{blockedby}, $b,
962 foreach my $b (@oldblockerlist) {
963 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
964 push @{$removedblocks{$b}}, $ref;
967 foreach my $b (split ' ', $data->{blockedby}) {
968 if (! grep { $_ eq $b } @oldblockerlist) {
969 push @{$addedblocks{$b}}, $ref;
972 } while (&getnextbug);
974 # Now that the blockedby data is updated, change blocks data
975 # to match the changes.
976 foreach $ref (keys %addedblocks) {
978 foreach my $b (@{$addedblocks{$ref}}) {
979 $data->{blocks} = manipset($data->{blocks}, $b, 1);
984 foreach $ref (keys %removedblocks) {
986 foreach my $b (@{$removedblocks{$ref}}) {
987 $data->{blocks} = manipset($data->{blocks}, $b, 0);
993 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
995 $ref= $1; my $newtitle= $2;
996 $bug_affected{$ref}=1;
997 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
998 $ref = $clonebugs{$ref};
1001 if (&checkpkglimit) {
1003 $affected_packages{$data->{package}} = 1;
1004 add_recipients(data => $data,
1005 recipients => \%recipients,
1006 transcript => $transcript,
1007 ($dl > 0 ? (debug => $transcript):()),
1009 my $oldtitle = $data->{subject};
1010 $data->{subject}= $newtitle;
1011 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
1013 print {$transcript} "$action\n";
1014 if (length($data->{done})) {
1015 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
1017 print {$transcript} "\n";
1024 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
1027 $bug_affected{$ref} = 1;
1029 if (!length($data->{mergedwith})) {
1030 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
1033 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1034 $action= "Disconnected #$ref from all other report(s).";
1035 my @newmergelist= split(/ /,$data->{mergedwith});
1037 @bug_affected{@newmergelist} = 1 x @newmergelist;
1039 $affected_packages{$data->{package}} = 1;
1040 add_recipients(data => $data,
1041 recipients => \%recipients,
1042 transcript => $transcript,
1043 ($dl > 0 ? (debug => $transcript):()),
1045 $data->{mergedwith}= ($ref == $discref) ? ''
1046 : join(' ',grep($_ ne $ref,@newmergelist));
1047 } while (&getnextbug);
1050 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
1052 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
1053 my @newmergelist= ();
1058 while (defined($ref= shift(@tomerge))) {
1059 print {$transcript} "D| checking merge $ref\n" if $dl;
1061 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1062 $ref = $clonebugs{$ref};
1064 next if grep($_ == $ref,@newmergelist);
1065 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1066 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1068 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1070 &checkmatch('package','m_package',$data->{package},@newmergelist);
1071 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
1072 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
1073 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
1074 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
1075 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
1076 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
1077 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
1078 &checkmatch('summary','m_summary',$data->{summary},@newmergelist);
1079 &checkmatch('affects','m_affects',$data->{affects},@newmergelist);
1080 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
1081 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
1082 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
1083 if (length($mismatch)) {
1084 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
1087 &cancelbug; @newmergelist=(); last;
1089 push(@newmergelist,$ref);
1090 push(@tomerge,split(/ /,$data->{mergedwith}));
1093 if (@newmergelist) {
1094 @newmergelist= sort { $a <=> $b } @newmergelist;
1095 $action= "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,
1101 recipients => \%recipients,
1102 transcript => $transcript,
1103 ($dl > 0 ? (debug => $transcript):()),
1105 @bug_affected{@newmergelist} = 1 x @newmergelist;
1106 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1107 $data->{keywords}= join(' ', keys %tags);
1108 $data->{found_versions}= [sort keys %found];
1109 $data->{fixed_versions}= [sort keys %fixed];
1112 print {$transcript} "$action\n\n";
1115 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1117 my @temp = split /\s+\#?/,$1;
1118 my $master_bug = shift @temp;
1119 my $master_bug_data;
1120 my @tomerge = sort { $a <=> $b } @temp;
1121 unshift @tomerge,$master_bug;
1122 print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1123 my @newmergelist= ();
1127 # Here we try to do the right thing.
1128 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1129 # If not, we discard the found and fixed.
1130 # Everything else we set to the values of the first bug.
1132 while (defined($ref= shift(@tomerge))) {
1133 print {$transcript} "D| checking merge $ref\n" if $dl;
1135 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1136 $ref = $clonebugs{$ref};
1138 next if grep($_ == $ref,@newmergelist);
1139 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1140 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1142 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1143 $master_bug_data = $data if not defined $master_bug_data;
1144 if ($data->{package} ne $master_bug_data->{package}) {
1145 print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1146 "$gBug $ref is not in the same package as $master_bug\n";
1148 &cancelbug; @newmergelist=(); last;
1150 for my $t (split /\s+/,$data->{keywords}) {
1153 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1154 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1155 push(@newmergelist,$ref);
1156 push(@tomerge,split(/ /,$data->{mergedwith}));
1159 if (@newmergelist) {
1160 @newmergelist= sort { $a <=> $b } @newmergelist;
1161 $action= "Forcibly Merged @newmergelist.";
1162 delete @fixed{keys %found};
1163 for $ref (@newmergelist) {
1164 &getbug || die "huh ? $gBug $ref disappeared during merge";
1165 $affected_packages{$data->{package}} = 1;
1166 add_recipients(data => $data,
1167 recipients => \%recipients,
1168 transcript => $transcript,
1169 ($dl > 0 ? (debug => $transcript):()),
1171 @bug_affected{@newmergelist} = 1 x @newmergelist;
1172 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1173 $data->{keywords}= join(' ', keys %tags);
1174 $data->{found_versions}= [sort keys %found];
1175 $data->{fixed_versions}= [sort keys %fixed];
1176 my @field_list = qw(forwarded package severity blocks blockedby owner done affects summary);
1177 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1180 print {$transcript} "$action\n\n";
1183 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1187 my @newclonedids = split /\s+/, $2;
1188 my $newbugsneeded = scalar(@newclonedids);
1191 $bug_affected{$ref} = 1;
1193 $affected_packages{$data->{package}} = 1;
1194 if (length($data->{mergedwith})) {
1195 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1199 &filelock("nextnumber.lock");
1200 open(N,"nextnumber") || die "nextnumber: read: $!";
1201 my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1202 my $firstref= $v+0; $v += $newbugsneeded;
1203 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1206 my $lastref = $firstref + $newbugsneeded - 1;
1208 if ($newbugsneeded == 1) {
1209 $action= "$gBug $origref cloned as bug $firstref.";
1211 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1214 my $blocks = $data->{blocks};
1215 my $blockedby = $data->{blockedby};
1218 my $ohash = get_hashname($origref);
1219 my $clone = $firstref;
1220 @bug_affected{@newclonedids} = 1 x @newclonedids;
1221 for my $newclonedid (@newclonedids) {
1222 $clonebugs{$newclonedid} = $clone;
1224 my $hash = get_hashname($clone);
1225 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1226 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1227 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1228 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1229 &bughook('new', $clone, $data);
1231 # Update blocking info of bugs blocked by or blocking the
1233 foreach $ref (split ' ', $blocks) {
1235 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1238 foreach $ref (split ' ', $blockedby) {
1240 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1248 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1250 my @pkgs = split /\s+/, $1;
1251 if (scalar(@pkgs) > 0) {
1252 %limit_pkgs = map { ($_, 1) } @pkgs;
1253 print {$transcript} "Ignoring bugs not assigned to: " .
1254 join(" ", keys(%limit_pkgs)) . "\n\n";
1257 print {$transcript} "Not ignoring any bugs.\n\n";
1259 } elsif (m/^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/i) {
1262 my $add_remove = $2 || '';
1263 my $packages = $3 || '';
1264 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1265 $bug_affected{$ref} = 1;
1267 affects(bug => $ref,
1268 transcript => $transcript,
1269 ($dl > 0 ? (debug => $transcript):()),
1270 requester => $header{from},
1271 request_addr => $controlrequestaddr,
1273 recipients => \%recipients,
1274 packages => [splitpackages($3)],
1275 ($add_remove eq '+'?(add => 1):()),
1276 ($add_remove eq '-'?(remove => 1):()),
1281 print {$transcript} "Failed to give $ref a summary: $@";
1284 } elsif (m/^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/i) {
1287 my $summary_msg = length($2)?$2:undef;
1288 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1289 $bug_affected{$ref} = 1;
1291 summary(bug => $ref,
1292 transcript => $transcript,
1293 ($dl > 0 ? (debug => $transcript):()),
1294 requester => $header{from},
1295 request_addr => $controlrequestaddr,
1297 recipients => \%recipients,
1298 summary => $summary_msg,
1303 print {$transcript} "Failed to give $ref a summary: $@";
1306 } elsif (m/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) {
1309 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1311 if ($newowner eq '!') {
1312 $newowner = $replyto;
1314 $bug_affected{$ref} = 1;
1317 transcript => $transcript,
1318 ($dl > 0 ? (debug => $transcript):()),
1319 requester => $header{from},
1320 request_addr => $controlrequestaddr,
1322 recipients => \%recipients,
1328 print {$transcript} "Failed to mark $ref as having an owner: $@";
1330 } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) {
1333 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1334 $bug_affected{$ref} = 1;
1337 transcript => $transcript,
1338 ($dl > 0 ? (debug => $transcript):()),
1339 requester => $header{from},
1340 request_addr => $controlrequestaddr,
1342 recipients => \%recipients,
1348 print {$transcript} "Failed to mark $ref as not having an owner: $@";
1350 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1353 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1354 $bug_affected{$ref} = 1;
1356 bug_unarchive(bug => $ref,
1357 transcript => $transcript,
1358 ($dl > 0 ? (debug => $transcript):()),
1359 affected_bugs => \%bug_affected,
1360 requester => $header{from},
1361 request_addr => $controlrequestaddr,
1363 recipients => \%recipients,
1369 } elsif (m/^archive\s+#?(\d+)$/i) {
1372 $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
1373 $bug_affected{$ref} = 1;
1375 bug_archive(bug => $ref,
1376 transcript => $transcript,
1377 ($dl > 0 ? (debug => $transcript):()),
1379 archive_unarchived => 0,
1380 affected_bugs => \%bug_affected,
1381 requester => $header{from},
1382 request_addr => $controlrequestaddr,
1384 recipients => \%recipients,
1391 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1393 if (++$unknowns >= 5) {
1394 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1399 if ($procline>$#bodylines) {
1400 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1402 if (!$ok && !$quickabort) {
1404 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1406 print {$transcript} "\n";
1409 my @maintccs = determine_recipients(recipients => \%recipients,
1413 my $maintccs = 'Cc: '.join(",\n ",
1414 determine_recipients(recipients => \%recipients,
1420 $packagepr = "X-${gProject}-PR-Package: " . join(keys %affected_packages) . "\n" if keys %affected_packages;
1422 # Add Bcc's to subscribed bugs
1423 # now handled by Debbugs::Recipients
1424 #push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1426 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1427 $header{'subject'} = "your mail";
1430 # Error text here advertises how many errors there were
1431 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1434 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1436 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1437 In-Reply-To: $header{'message-id'}
1440 References: $header{'message-id'}
1441 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1443 ${packagepr}X-$gProject-PR-Message: transcript
1445 ${transcript_scalar}Please contact me if you need assistance.
1448 (administrator, $gProject $gBugs database)
1451 my $repliedshow= join(', ',$replyto,
1452 determine_recipients(recipients => \%recipients,
1457 # -1 is the service.in log
1458 &filelock("lock/-1");
1459 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1461 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1463 "<strong>Request received</strong> from <code>".
1464 html_escape($header{'from'})."</code>\n".
1465 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1467 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1468 close(AP) || die "open db-h/-1.log: $!";
1470 utime(time,time,"db-h");
1472 &sendmailmessage($reply,
1473 exists $header{'x-debbugs-no-ack'}?():$replyto,
1474 make_list(values %{{determine_recipients(recipients => \%recipients,
1480 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1482 sub sendmailmessage {
1483 my ($message,@recips) = @_;
1484 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1485 send_mail_message(message => $message,
1486 recipients => \@recips,
1492 my ($template,$extra_var) = @_;
1494 my $variables = {config => \%config,
1495 defined($ref)?(ref => $ref):(),
1496 defined($data)?(data => $data):(),
1499 my $hole_var = {'&bugurl' =>
1501 'http://'.$config{cgi_domain}.'/'.
1502 Debbugs::CGI::bug_url($_[0]);
1505 return fill_in_template(template => $template,
1506 variables => $variables,
1507 hole_var => $hole_var,
1511 =head2 message_body_template
1513 message_body_template('mail/ack',{ref=>'foo'});
1515 Creates a message body using a template
1519 sub message_body_template{
1520 my ($template,$extra_var) = @_;
1522 my $body = fill_template($template,$extra_var);
1523 return fill_template('mail/message_body',
1531 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1532 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1536 #sub unimplemented {
1537 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1539 our %checkmatch_values;
1541 my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1543 if (@newmergelist) {
1544 $mvarvalue = $checkmatch_values{$mvarname};
1545 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1548 "Values for \`$string' don't match:\n".
1549 " #$newmergelist[0] has \`$mvarvalue';\n".
1550 " #$ref has \`$svarvalue'\n"
1551 if $mvarvalue ne $svarvalue;
1553 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1555 $checkmatch_values{$mvarname} = $svarvalue;
1560 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1561 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1573 my %h = map { $_ => 1 } split ' ', $list;
1580 return join ' ', sort keys %h;
1583 # High-level bug manipulation calls
1584 # Do announcements themselves
1586 # Possible calling sequences:
1587 # setbug (returns 0)
1589 # setbug (returns 1)
1590 # &transcript(something)
1593 # setbug (returns 1)
1594 # $action= (something)
1596 # (modify s_* variables)
1597 # } while (getnextbug);
1602 &dlen("nochangebug");
1603 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1605 &endmerge if $manybugs;
1607 &dlex("nochangebug");
1611 our @thisbugmergelist;
1614 &dlen("setbug $ref");
1615 if ($ref =~ m/^-\d+/) {
1616 if (!defined $clonebugs{$ref}) {
1618 &dlex("setbug => noclone");
1621 $ref = $clonebugs{$ref};
1623 $state eq 'idle' || die "$state ?";
1626 &dlex("setbug => 0s");
1630 if (!&checkpkglimit) {
1635 @thisbugmergelist= split(/ /,$data->{mergedwith});
1636 if (!@thisbugmergelist) {
1641 &dlex("setbug => 1s");
1650 &dlex("setbug => 0mc");
1654 $state= 'multiple'; $sref=$ref;
1655 &dlex("setbug => 1m");
1660 &dlen("getnextbug");
1661 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1663 if (!$manybugs || !@thisbugmergelist) {
1664 length($action) || die;
1665 print {$transcript} "$action\n$extramessage\n";
1666 &endmerge if $manybugs;
1668 &dlex("getnextbug => 0");
1671 $ref= shift(@thisbugmergelist);
1672 &getbug || die "bug $ref disappeared";
1674 &dlex("getnextbug => 1");
1678 # Low-level bug-manipulation calls
1679 # Do no announcements
1681 # getbug (returns 0)
1683 # getbug (returns 1)
1687 # $action= (something)
1688 # getbug (returns 1)
1690 # getbug (returns 1)
1692 # [getbug (returns 0)]
1693 # &transcript("$action\n\n")
1696 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1697 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1701 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1702 &filelock('lock/merge');
1703 $mergelowstate='locked';
1709 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1711 $mergelowstate='idle';
1716 &dlen("getbug $ref");
1717 $lowstate eq 'idle' || die "$state ?";
1718 # Only use unmerged bugs here
1719 if (($data = &lockreadbug($ref,'db-h'))) {
1722 &dlex("getbug => 1");
1727 &dlex("getbug => 0");
1733 $lowstate eq 'open' || die "$state ?";
1740 &dlen("savebug $ref");
1741 $lowstate eq 'open' || die "$lowstate ?";
1742 length($action) || die;
1743 $ref == $sref || die "read $sref but saving $ref ?";
1744 append_action_to_log(bug => $ref,
1746 requester => $header{from},
1747 request_addr => $controlrequestaddr,
1751 unlockwritebug($ref, $data);
1758 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1763 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1770 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1771 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1777 print {$transcript} "\n";
1783 print {$transcript} "\n";
1789 sub sendtxthelpraw {
1790 my ($relpath,$description) = @_;
1792 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1793 while(<D>) { $doc.=$_; }
1795 print {$transcript} "Sending $description in separate message.\n";
1796 &sendmailmessage(<<END.$doc,$replyto);
1797 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1799 Subject: $gProject $gBug help: $description
1800 References: $header{'message-id'}
1801 In-Reply-To: $header{'message-id'}
1802 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1804 X-$gProject-PR-Message: doc-text $relpath
1810 sub sendlynxdocraw {
1811 my ($relpath,$description) = @_;
1813 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1814 while(<L>) { $doc.=$_; }
1816 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1817 print {$transcript} "Information ($description) is not available -\n".
1818 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1821 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1823 print {$transcript} "Sending $description.\n";
1824 &sendmailmessage(<<END.$doc,$replyto);
1825 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1827 Subject: $gProject $gBugs information: $description
1828 References: $header{'message-id'}
1829 In-Reply-To: $header{'message-id'}
1830 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1832 X-$gProject-PR-Message: doc-html $relpath
1841 my ($wherefrom,$path,$description) = @_;
1842 if ($wherefrom eq "ftp.d.o") {
1843 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1845 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1846 print {$transcript} "$description is not available.\n";
1849 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1852 } elsif ($wherefrom eq "local") {
1854 $doc = do { local $/; <P> };
1857 print {$transcript} "internal errror: info files location unknown.\n";
1860 print {$transcript} "Sending $description.\n";
1861 &sendmailmessage(<<END.$doc,$replyto);
1862 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1864 Subject: $gProject $gBugs information: $description
1865 References: $header{'message-id'}
1866 In-Reply-To: $header{'message-id'}
1867 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1869 X-$gProject-PR-Message: getinfo
1871 $description follows:
1875 print {$transcript} "\n";