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