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(:archive :log);
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;
163 for ($procline=0; $procline<=$#bodylines; $procline++) {
168 $state eq 'idle' || print "state: $state ?\n";
169 $lowstate eq 'idle' || print "lowstate: $lowstate ?\n";
170 $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n";
172 print {$transcript} "Stopping processing here.\n\n";
175 $_= $bodylines[$procline]; s/\s+$//;
177 print {$transcript} "> $_\n";
180 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
181 print {$transcript} "Stopping processing here.\n\n";
183 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
185 print {$transcript} "Debug level $dl.\n\n";
186 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
188 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
189 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
191 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
192 "detailed logs for $gBug#$ref");
193 } elsif (m/^index(\s+full)?$/i) {
194 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
196 $ok++; # well, it's not really ok, but it fixes #81224 :)
197 } elsif (m/^index-summary\s+by-package$/i) {
198 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
200 $ok++; # well, it's not really ok, but it fixes #81224 :)
201 } elsif (m/^index-summary(\s+by-number)?$/i) {
202 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
204 $ok++; # well, it's not really ok, but it fixes #81224 :)
205 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
206 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
207 } elsif (m/^index(\s+|-)maints?$/i) {
208 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
209 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
211 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
212 "$gBug list for maintainer \`$maint'");
214 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
216 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
217 "$gBug list for package $package");
219 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
220 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
222 $ok++; # well, it's not really ok, but it fixes #81224 :)
223 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
224 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
226 $ok++; # well, it's not really ok, but it fixes #81224 :)
227 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
228 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
230 $ok++; # well, it's not really ok, but it fixes #81224 :)
231 } elsif (m/^getinfo\s+([\w.-]+)$/i) {
232 # the following is basically a Debian-specific kludge, but who cares
234 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
235 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
236 } elsif ($req =~ /^override\.(\w+)\.([\w.-]+)$/i) {
238 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
239 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
240 &sendinfo("local", "$gConfigDir/$req", "$req file");
242 print {$transcript} "Info file $req does not exist.\n\n";
244 } elsif (m/^help/i) {
246 print {$transcript} "\n";
248 } elsif (m/^refcard/i) {
249 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
250 } elsif (m/^subscribe/i) {
251 print {$transcript} <<END;
252 There is no $gProject $gBug mailing list. If you wish to review bug reports
253 please do so via http://$gWebDomain/ or ask this mail server
255 soon: MAILINGLISTS_TEXT
257 } elsif (m/^unsubscribe/i) {
258 print {$transcript} <<END;
259 soon: UNSUBSCRIBE_TEXT
260 soon: MAILINGLISTS_TEXT
262 } elsif (m/^user\s+(\S+)\s*$/i) {
264 if (Debbugs::User::is_valid_user($newuser)) {
265 my $olduser = ($user ne "" ? " (was $user)" : "");
266 print {$transcript} "Setting user to $newuser$olduser.\n";
270 print {$transcript} "Selected user id ($newuser) invalid, sorry\n";
275 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
278 my $hidden = ($2 ne "");
285 print {$transcript} "No valid user selected\n";
289 if (not $indicated_user and defined $user) {
290 print {$transcript} "User is $user\n";
294 while (++$procline <= $#bodylines) {
295 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
299 print {$transcript} "> $bodylines[$procline]\n";
301 my ($o, $txt) = ($1, $2);
302 if ($#cats == -1 && $o eq "+") {
303 print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n";
309 unless (ref($cats[-1]) eq "HASH") {
310 $cats[-1] = { "nam" => $cats[-1],
311 "pri" => [], "ttl" => [] };
314 my ($desc, $ord, $op);
315 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
316 $desc = $1; $ord = $3; $op = "";
317 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
318 $desc = $1; $ord = $3; $op = $4;
319 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
320 $desc = ""; $op = $1;
322 print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n";
327 $ord = 999 unless defined $ord;
330 push @{$cats[-1]->{"pri"}}, $prefix . $op;
331 push @{$cats[-1]->{"ttl"}}, $desc;
332 push @ords, "$ord $catsec";
334 $cats[-1]->{"def"} = $desc;
335 push @ords, "$ord DEF";
338 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
339 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
340 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
341 } elsif ($o eq "*") {
344 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
345 $name = $1; $prefix = $3;
347 $name = $txt; $prefix = "";
352 # XXX: got @cats, now do something with it
353 my $u = Debbugs::User::get_user($user);
355 print {$transcript} "Added usercategory $catname.\n\n";
356 $u->{"categories"}->{$catname} = [ @cats ];
358 push @{$u->{visible_cats}},$catname;
361 print {$transcript} "Removed usercategory $catname.\n\n";
362 delete $u->{"categories"}->{$catname};
363 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
366 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
369 my $addsubcode = $3 || "+";
371 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
372 $ref = $clonebugs{$ref};
375 print {$transcript} "No valid user selected\n";
379 if (not $indicated_user and defined $user) {
380 print {$transcript} "User is $user\n";
385 Debbugs::User::read_usertags(\%ut, $user);
386 my @oldtags = (); my @newtags = (); my @badtags = ();
388 for my $t (split /[,\s]+/, $tags) {
389 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
396 print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
399 for my $t (keys %chtags) {
400 $ut{$t} = [] unless defined $ut{$t};
402 for my $t (keys %ut) {
403 my %res = map { ($_, 1) } @{$ut{$t}};
404 push @oldtags, $t if defined $res{$ref};
405 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
406 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
407 : $addsubcode eq "=");
408 $res{$ref} = 1 if ($addop && defined $chtags{$t});
409 delete $res{$ref} if ($del);
410 push @newtags, $t if defined $res{$ref};
411 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
414 print {$transcript} "There were no usertags set.\n";
416 print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
418 print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
419 Debbugs::User::write_usertags(\%ut, $user);
421 } elsif (!$control) {
422 print {$transcript} <<END;
423 Unknown command or malformed arguments to command.
424 (Use control\@$gEmailDomain to manipulate reports.)
428 if (++$unknowns >= 3) {
429 print {$transcript} "Too many unknown commands, stopping here.\n\n";
432 #### "developer only" ones start here
433 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
436 $bug_affected{$ref}=1;
439 print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
440 if (length($data->{done}) and not defined($version)) {
441 print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
446 "marked as fixed in version $version" :
448 ", send any further explanations to $data->{originator}";
450 add_recipients(data => $data, recipients => \%recipients);
451 if ( length( $gDoneList ) > 0 and
452 length( $gListDomain ) > 0 ) {
453 add_recipients(recipients => \%recipients,
455 address => "$gDoneList\@$gListDomain",
458 $data->{done}= $replyto;
459 my @keywords= split ' ', $data->{keywords};
460 my $extramessage = '';
461 if (grep $_ eq 'pending', @keywords) {
462 $extramessage= "Removed pending tag.\n";
463 $data->{keywords}= join ' ', grep $_ ne 'pending',
466 addfixedversions($data, $data->{package}, $version, 'binary');
469 From: $gMaintainerEmail ($gProject $gBug Tracking System)
470 To: $data->{originator}
471 Subject: $gBug#$ref acknowledged by developer
473 References: $header{'message-id'} $data->{msgid}
474 In-Reply-To: $data->{msgid}
475 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
476 Reply-To: $ref\@$gEmailDomain
477 X-$gProject-PR-Message: they-closed-control $ref
479 This is an automatic notification regarding your $gBug report
480 #$ref: $data->{subject},
481 which was filed against the $data->{package} package.
483 It has been marked as closed by one of the developers, namely
486 You should be hearing from them with a substantive response shortly,
487 in case you haven't already. If not, please contact them directly.
490 (administrator, $gProject $gBugs database)
493 &sendmailmessage($message,$data->{originator});
494 } while (&getnextbug);
497 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
501 $bug_affected{$ref}=1;
503 $newpackage =~ y/A-Z/a-z/;
505 if (length($data->{package})) {
506 $action= "$gBug reassigned from package \`$data->{package}'".
507 " to \`$newpackage'.";
509 $action= "$gBug assigned to package \`$newpackage'.";
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 add_recipients(data => $data, recipients => \%recipients);
541 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
542 $data->{fixed_versions}= [];
544 } while (&getnextbug);
547 } elsif (m{^found\s+\#?(-?\d+)
548 (?:\s+((?:$config{package_name_re}\/)?
549 $config{package_version_re}))?$}ix) {
554 if (!length($data->{done}) and not defined($version)) {
555 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
561 "$gBug marked as found in version $version." :
564 add_recipients(data => $data, recipients => \%recipients);
565 # The 'done' field gets a bit weird with version
566 # tracking, because a bug may be closed by multiple
567 # people in different branches. Until we have something
568 # more flexible, we set it every time a bug is fixed,
569 # and clear it when a bug is found in a version greater
570 # than any version in which the bug is fixed or when
571 # a bug is found and there is no fixed version
572 if (defined $version) {
573 my ($version_only) = $version =~ m{([^/]+)$};
574 addfoundversions($data, $data->{package}, $version, 'binary');
575 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
576 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
577 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
578 $action = "$gBug marked as found in version $version and reopened."
579 if length $data->{done};
583 # Versionless found; assume old-style "not fixed at
585 $data->{fixed_versions} = [];
588 } while (&getnextbug);
591 } elsif (m[^notfound\s+\#?(-?\d+)\s+
592 ((?:$config{package_name_re}\/)?
598 $action= "$gBug no longer marked as found in version $version.";
599 if (length($data->{done})) {
600 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
603 add_recipients(data => $data, recipients => \%recipients);
604 removefoundversions($data, $data->{package}, $version, 'binary');
605 } while (&getnextbug);
608 elsif (m[^fixed\s+\#?(-?\d+)\s+
609 ((?:$config{package_name_re}\/)?
610 $config{package_version_re})\s*$]ix) {
617 "$gBug marked as fixed in version $version." :
620 add_recipients(data => $data, recipients => \%recipients);
621 addfixedversions($data, $data->{package}, $version, 'binary');
622 } while (&getnextbug);
625 elsif (m[^notfixed\s+\#?(-?\d+)\s+
626 ((?:$config{package_name_re}\/)?
634 "$gBug no longer marked as fixed in version $version." :
637 add_recipients(data => $data, recipients => \%recipients);
638 removefixedversions($data, $data->{package}, $version, 'binary');
639 } while (&getnextbug);
642 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
643 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
646 $bug_affected{$ref}=1;
647 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
648 $ref = $clonebugs{$ref};
650 if (not Mail::RFC822::Address::valid($newsubmitter)) {
651 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
655 if (&checkpkglimit) {
657 add_recipients(data => $data, recipients => \%recipients);
658 $oldsubmitter= $data->{originator};
659 $data->{originator}= $newsubmitter;
660 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
662 print {$transcript} "$action\n";
663 if (length($data->{done})) {
664 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
666 print {$transcript} "\n";
668 From: $gMaintainerEmail ($gProject $gBug Tracking System)
670 Subject: $gBug#$ref submitter address changed
672 References: $header{'message-id'} $data->{msgid}
673 In-Reply-To: $data->{msgid}
674 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
675 Reply-To: $ref\@$gEmailDomain
676 X-$gProject-PR-Message: submitter-changed $ref
678 The submitter address recorded for your $gBug report
679 #$ref: $data->{subject}
682 The old submitter address for this report was
684 The new submitter address is
687 This change was made by
689 If it was incorrect, please contact them directly.
692 (administrator, $gProject $gBugs database)
695 &sendmailmessage($message,$oldsubmitter);
702 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
706 $bug_affected{$ref}=1;
708 if (length($data->{forwarded})) {
709 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
711 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
713 if (length($data->{done})) {
714 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
717 add_recipients(data => $data, recipients => \%recipients);
718 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
719 add_recipients(recipients => \%recipients,
721 address => "$gForwardList\@$gListDomain",
724 $data->{forwarded}= $whereto;
725 } while (&getnextbug);
727 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
730 $bug_affected{$ref}=1;
732 if (!length($data->{forwarded})) {
733 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
736 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
738 add_recipients(data => $data, recipients => \%recipients);
739 $data->{forwarded}= '';
740 } while (&getnextbug);
743 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
744 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
747 $bug_affected{$ref}=1;
749 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
750 print {$transcript} "Severity level \`$newseverity' is not known.\n".
751 "Recognized are: $gShowSeverities.\n\n";
753 } elsif (exists $gObsoleteSeverities{$newseverity}) {
754 print {$transcript} "Severity level \`$newseverity' is obsolete. " .
755 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
758 my $printseverity= $data->{severity};
759 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
760 $action= "Severity set to \`$newseverity' from \`$printseverity'";
762 add_recipients(data => $data, recipients => \%recipients);
763 if (defined $gStrongList and isstrongseverity($newseverity)) {
764 addbcc("$gStrongList\@$gListDomain");
766 $data->{severity}= $newseverity;
767 } while (&getnextbug);
769 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
774 $bug_affected{$ref}=1;
776 if (defined $addsubcode) {
777 $addsub = "sub" if ($addsubcode eq "-");
778 $addsub = "add" if ($addsubcode eq "+");
779 $addsub = "set" if ($addsubcode eq "=");
783 foreach my $t (split /[\s,]+/, $tags) {
784 if (!grep($_ eq $t, @gTags)) {
791 print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
792 "Recognized are: ".join(' ', @gTags).".\n\n";
796 if ($data->{keywords} eq '') {
797 print {$transcript} "There were no tags set.\n";
799 print {$transcript} "Tags were: $data->{keywords}\n";
801 if ($addsub eq "set") {
802 $action= "Tags set to: " . join(", ", @okaytags);
803 } elsif ($addsub eq "add") {
804 $action= "Tags added: " . join(", ", @okaytags);
805 } elsif ($addsub eq "sub") {
806 $action= "Tags removed: " . join(", ", @okaytags);
809 add_recipients(data => $data, recipients => \%recipients);
810 $data->{keywords} = '' if ($addsub eq "set");
811 # Allow removing obsolete tags.
812 if ($addsub eq "sub") {
813 foreach my $t (@badtags) {
814 $data->{keywords} = join ' ', grep $_ ne $t,
815 split ' ', $data->{keywords};
818 # Now process all other additions and subtractions.
819 foreach my $t (@okaytags) {
820 $data->{keywords} = join ' ', grep $_ ne $t,
821 split ' ', $data->{keywords};
822 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
824 $data->{keywords} =~ s/\s*$//;
825 } while (&getnextbug);
827 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
829 my $bugnum = $2; my $blockers = $4;
831 $addsub = "sub" if ($1 eq "un");
832 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
833 $bugnum = $clonebugs{$bugnum};
838 foreach my $b (split /[\s,]+/, $blockers) {
842 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
843 $ref = $clonebugs{$ref};
847 push @okayblockers, $ref;
849 # add to the list all bugs that are merged with $b,
850 # because all of their data must be kept in sync
851 my @thisbugmergelist= split(/ /,$data->{mergedwith});
854 foreach $ref (@thisbugmergelist) {
856 push @okayblockers, $ref;
863 push @badblockers, $ref;
867 push @badblockers, $b;
871 print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
877 if ($data->{blockedby} eq '') {
878 print {$transcript} "Was not blocked by any bugs.\n";
880 print {$transcript} "Was blocked by: $data->{blockedby}\n";
882 if ($addsub eq "set") {
883 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
884 } elsif ($addsub eq "add") {
885 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
886 } elsif ($addsub eq "sub") {
887 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
892 add_recipients(data => $data, recipients => \%recipients);
893 my @oldblockerlist = split ' ', $data->{blockedby};
894 $data->{blockedby} = '' if ($addsub eq "set");
895 foreach my $b (@okayblockers) {
896 $data->{blockedby} = manipset($data->{blockedby}, $b,
900 foreach my $b (@oldblockerlist) {
901 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
902 push @{$removedblocks{$b}}, $ref;
905 foreach my $b (split ' ', $data->{blockedby}) {
906 if (! grep { $_ eq $b } @oldblockerlist) {
907 push @{$addedblocks{$b}}, $ref;
910 } while (&getnextbug);
912 # Now that the blockedby data is updated, change blocks data
913 # to match the changes.
914 foreach $ref (keys %addedblocks) {
916 foreach my $b (@{$addedblocks{$ref}}) {
917 $data->{blocks} = manipset($data->{blocks}, $b, 1);
922 foreach $ref (keys %removedblocks) {
924 foreach my $b (@{$removedblocks{$ref}}) {
925 $data->{blocks} = manipset($data->{blocks}, $b, 0);
931 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
933 $ref= $1; my $newtitle= $2;
934 $bug_affected{$ref}=1;
935 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
936 $ref = $clonebugs{$ref};
939 if (&checkpkglimit) {
941 add_recipients(data => $data, recipients => \%recipients);
942 my $oldtitle = $data->{subject};
943 $data->{subject}= $newtitle;
944 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
946 print {$transcript} "$action\n";
947 if (length($data->{done})) {
948 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
950 print {$transcript} "\n";
957 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
960 $bug_affected{$ref} = 1;
962 if (!length($data->{mergedwith})) {
963 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
966 $mergelowstate eq 'locked' || die "$mergelowstate ?";
967 $action= "Disconnected #$ref from all other report(s).";
968 my @newmergelist= split(/ /,$data->{mergedwith});
970 @bug_affected{@newmergelist} = 1 x @newmergelist;
972 add_recipients(data => $data, recipients => \%recipients);
973 $data->{mergedwith}= ($ref == $discref) ? ''
974 : join(' ',grep($_ ne $ref,@newmergelist));
975 } while (&getnextbug);
978 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
980 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
981 my @newmergelist= ();
986 while (defined($ref= shift(@tomerge))) {
987 print {$transcript} "D| checking merge $ref\n" if $dl;
989 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
990 $ref = $clonebugs{$ref};
992 next if grep($_ == $ref,@newmergelist);
993 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
994 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
996 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
998 &checkmatch('package','m_package',$data->{package},@newmergelist);
999 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
1000 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
1001 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
1002 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
1003 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
1004 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
1005 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
1006 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
1007 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
1008 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
1009 if (length($mismatch)) {
1010 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
1013 &cancelbug; @newmergelist=(); last;
1015 push(@newmergelist,$ref);
1016 push(@tomerge,split(/ /,$data->{mergedwith}));
1019 if (@newmergelist) {
1020 @newmergelist= sort { $a <=> $b } @newmergelist;
1021 $action= "Merged @newmergelist.";
1022 delete @fixed{keys %found};
1023 for $ref (@newmergelist) {
1024 &getbug || die "huh ? $gBug $ref disappeared during merge";
1025 add_recipients(data => $data, recipients => \%recipients);
1026 @bug_affected{@newmergelist} = 1 x @newmergelist;
1027 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1028 $data->{keywords}= join(' ', keys %tags);
1029 $data->{found_versions}= [sort keys %found];
1030 $data->{fixed_versions}= [sort keys %fixed];
1033 print {$transcript} "$action\n\n";
1036 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1038 my @temp = split /\s+\#?/,$1;
1039 my $master_bug = shift @temp;
1040 my $master_bug_data;
1041 my @tomerge = sort { $a <=> $b } @temp;
1042 unshift @tomerge,$master_bug;
1043 print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1044 my @newmergelist= ();
1048 # Here we try to do the right thing.
1049 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1050 # If not, we discard the found and fixed.
1051 # Everything else we set to the values of the first bug.
1053 while (defined($ref= shift(@tomerge))) {
1054 print {$transcript} "D| checking merge $ref\n" if $dl;
1056 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1057 $ref = $clonebugs{$ref};
1059 next if grep($_ == $ref,@newmergelist);
1060 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1061 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1063 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1064 $master_bug_data = $data if not defined $master_bug_data;
1065 if ($data->{package} ne $master_bug_data->{package}) {
1066 print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1067 "$gBug $ref is not in the same package as $master_bug\n";
1069 &cancelbug; @newmergelist=(); last;
1071 for my $t (split /\s+/,$data->{keywords}) {
1074 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1075 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1076 push(@newmergelist,$ref);
1077 push(@tomerge,split(/ /,$data->{mergedwith}));
1080 if (@newmergelist) {
1081 @newmergelist= sort { $a <=> $b } @newmergelist;
1082 $action= "Forcibly Merged @newmergelist.";
1083 delete @fixed{keys %found};
1084 for $ref (@newmergelist) {
1085 &getbug || die "huh ? $gBug $ref disappeared during merge";
1086 add_recipients(data => $data, recipients => \%recipients);
1087 @bug_affected{@newmergelist} = 1 x @newmergelist;
1088 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1089 $data->{keywords}= join(' ', keys %tags);
1090 $data->{found_versions}= [sort keys %found];
1091 $data->{fixed_versions}= [sort keys %fixed];
1092 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1093 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1096 print {$transcript} "$action\n\n";
1099 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1103 my @newclonedids = split /\s+/, $2;
1104 my $newbugsneeded = scalar(@newclonedids);
1107 $bug_affected{$ref} = 1;
1109 if (length($data->{mergedwith})) {
1110 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1114 &filelock("nextnumber.lock");
1115 open(N,"nextnumber") || die "nextnumber: read: $!";
1116 my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1117 my $firstref= $v+0; $v += $newbugsneeded;
1118 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1121 my $lastref = $firstref + $newbugsneeded - 1;
1123 if ($newbugsneeded == 1) {
1124 $action= "$gBug $origref cloned as bug $firstref.";
1126 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1129 my $blocks = $data->{blocks};
1130 my $blockedby = $data->{blockedby};
1133 my $ohash = get_hashname($origref);
1134 my $clone = $firstref;
1135 @bug_affected{@newclonedids} = 1 x @newclonedids;
1136 for my $newclonedid (@newclonedids) {
1137 $clonebugs{$newclonedid} = $clone;
1139 my $hash = get_hashname($clone);
1140 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1141 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1142 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1143 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1144 &bughook('new', $clone, $data);
1146 # Update blocking info of bugs blocked by or blocking the
1148 foreach $ref (split ' ', $blocks) {
1150 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1153 foreach $ref (split ' ', $blockedby) {
1155 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1163 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1165 my @pkgs = split /\s+/, $1;
1166 if (scalar(@pkgs) > 0) {
1167 %limit_pkgs = map { ($_, 1) } @pkgs;
1168 print {$transcript} "Ignoring bugs not assigned to: " .
1169 join(" ", keys(%limit_pkgs)) . "\n\n";
1172 print {$transcript} "Not ignoring any bugs.\n\n";
1174 } elsif (m/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)$/i) {
1178 if ($newowner eq '!') {
1179 $newowner = $replyto;
1181 $bug_affected{$ref} = 1;
1184 transcript => $transcript,
1185 ($dl > 0 ? (debug => $transcript):()),
1186 requester => $header{from},
1187 request_addr => $controlrequestaddr,
1189 recipients => \%recipients,
1193 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1196 $bug_affected{$ref} = 1;
1199 transcript => $transcript,
1200 ($dl > 0 ? (debug => $transcript):()),
1201 requester => $header{from},
1202 request_addr => $controlrequestaddr,
1204 recipients => \%recipients,
1210 print {$transcript} "Failed to mark $ref as not having an owner: $@";
1212 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1215 $bug_affected{$ref} = 1;
1217 bug_unarchive(bug => $ref,
1218 transcript => $transcript,
1219 ($dl > 0 ? (debug => $transcript):()),
1220 affected_bugs => \%bug_affected,
1221 requester => $header{from},
1222 request_addr => $controlrequestaddr,
1224 recipients => \%recipients,
1230 } elsif (m/^archive\s+#?(\d+)$/i) {
1233 $bug_affected{$ref} = 1;
1235 bug_archive(bug => $ref,
1236 transcript => $transcript,
1237 ($dl > 0 ? (debug => $transcript):()),
1239 archive_unarchived => 0,
1240 affected_bugs => \%bug_affected,
1241 requester => $header{from},
1242 request_addr => $controlrequestaddr,
1244 recipients => \%recipients,
1251 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1253 if (++$unknowns >= 5) {
1254 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1259 if ($procline>$#bodylines) {
1260 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1262 if (!$ok && !$quickabort) {
1264 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1266 print {$transcript} "\n";
1269 print {$transcript} "MC\n" if $dl>1;
1271 my @maintccaddrs = ();
1273 for my $maint (keys %maintccreasons) {
1274 print {$transcript} "MM|$maint|\n" if $dl>1;
1275 next if $maint eq $replyto;
1276 my $reasonstring= '';
1277 my $reasonsref= $maintccreasons{$maint};
1278 print {$transcript} "MY|$maint|\n" if $dl>2;
1279 for my $p (sort keys %$reasonsref) {
1280 print {$transcript} "MP|$p|\n" if $dl>2;
1281 $reasonstring.= ', ' if length($reasonstring);
1282 $reasonstring.= $p.' ' if length($p);
1283 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1285 if (length($reasonstring) > 40) {
1286 (substr $reasonstring, 37) = "...";
1288 $reasonstring = "" if (!defined($reasonstring));
1289 push(@maintccs,"$maint ($reasonstring)");
1290 push(@maintccaddrs,"$maint");
1295 print {$transcript} "MC|".join(', ',@maintccs)."|\n" if $dl>2;
1296 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1300 for my $maint (keys %maintccreasons) {
1301 for my $package (keys %{$maintccreasons{$maint}}) {
1302 next unless length $package;
1303 $packagepr{$package} = 1;
1307 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1309 # Add Bcc's to subscribed bugs
1310 # now handled by Debbugs::Recipients
1311 #push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1313 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1314 $header{'subject'} = "your mail";
1317 # Error text here advertises how many errors there were
1318 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1321 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1323 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1324 In-Reply-To: $header{'message-id'}
1327 References: $header{'message-id'}
1328 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1330 ${packagepr}X-$gProject-PR-Message: transcript
1332 ${transcript_scalar}Please contact me if you need assistance.
1335 (administrator, $gProject $gBugs database)
1338 my $repliedshow= join(', ',$replyto,@maintccaddrs);
1339 # -1 is the service.in log
1340 &filelock("lock/-1");
1341 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1343 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1345 "<strong>Request received</strong> from <code>".
1346 html_escape($header{'from'})."</code>\n".
1347 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1349 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1350 close(AP) || die "open db-h/-1.log: $!";
1352 utime(time,time,"db-h");
1354 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1356 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1358 sub sendmailmessage {
1359 my ($message,@recips) = @_;
1360 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1361 send_mail_message(message => $message,
1362 recipients => \@recips,
1368 my ($template,$extra_var) = @_;
1370 my $variables = {config => \%config,
1371 defined($ref)?(ref => $ref):(),
1372 defined($data)?(data => $data):(),
1375 my $hole_var = {'&bugurl' =>
1377 'http://'.$config{cgi_domain}.'/'.
1378 Debbugs::CGI::bug_url($_[0]);
1381 return fill_in_template(template => $template,
1382 variables => $variables,
1383 hole_var => $hole_var,
1387 =head2 message_body_template
1389 message_body_template('mail/ack',{ref=>'foo'});
1391 Creates a message body using a template
1395 sub message_body_template{
1396 my ($template,$extra_var) = @_;
1398 my $body = fill_template($template,$extra_var);
1399 return fill_template('mail/message_body',
1407 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1408 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1412 #sub unimplemented {
1413 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1417 my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1419 if (@newmergelist) {
1420 eval "\$mvarvalue= \$$mvarname";
1421 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1424 "Values for \`$string' don't match:\n".
1425 " #$newmergelist[0] has \`$mvarvalue';\n".
1426 " #$ref has \`$svarvalue'\n"
1427 if $mvarvalue ne $svarvalue;
1429 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1431 eval "\$$mvarname= \$svarvalue";
1436 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1437 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1449 my %h = map { $_ => 1 } split ' ', $list;
1456 return join ' ', sort keys %h;
1459 # High-level bug manipulation calls
1460 # Do announcements themselves
1462 # Possible calling sequences:
1463 # setbug (returns 0)
1465 # setbug (returns 1)
1466 # &transcript(something)
1469 # setbug (returns 1)
1470 # $action= (something)
1472 # (modify s_* variables)
1473 # } while (getnextbug);
1478 &dlen("nochangebug");
1479 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1481 &endmerge if $manybugs;
1483 &dlex("nochangebug");
1487 our @thisbugmergelist;
1490 &dlen("setbug $ref");
1491 if ($ref =~ m/^-\d+/) {
1492 if (!defined $clonebugs{$ref}) {
1494 &dlex("setbug => noclone");
1497 $ref = $clonebugs{$ref};
1499 $state eq 'idle' || die "$state ?";
1502 &dlex("setbug => 0s");
1506 if (!&checkpkglimit) {
1511 @thisbugmergelist= split(/ /,$data->{mergedwith});
1512 if (!@thisbugmergelist) {
1517 &dlex("setbug => 1s");
1526 &dlex("setbug => 0mc");
1530 $state= 'multiple'; $sref=$ref;
1531 &dlex("setbug => 1m");
1536 &dlen("getnextbug");
1537 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1539 if (!$manybugs || !@thisbugmergelist) {
1540 length($action) || die;
1541 print {$transcript} "$action\n$extramessage\n";
1542 &endmerge if $manybugs;
1544 &dlex("getnextbug => 0");
1547 $ref= shift(@thisbugmergelist);
1548 &getbug || die "bug $ref disappeared";
1550 &dlex("getnextbug => 1");
1554 # Low-level bug-manipulation calls
1555 # Do no announcements
1557 # getbug (returns 0)
1559 # getbug (returns 1)
1563 # $action= (something)
1564 # getbug (returns 1)
1566 # getbug (returns 1)
1568 # [getbug (returns 0)]
1569 # &transcript("$action\n\n")
1572 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1573 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1577 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1578 &filelock('lock/merge');
1579 $mergelowstate='locked';
1585 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1587 $mergelowstate='idle';
1592 &dlen("getbug $ref");
1593 $lowstate eq 'idle' || die "$state ?";
1594 # Only use unmerged bugs here
1595 if (($data = &lockreadbug($ref,'db-h'))) {
1598 &dlex("getbug => 1");
1603 &dlex("getbug => 0");
1609 $lowstate eq 'open' || die "$state ?";
1616 &dlen("savebug $ref");
1617 $lowstate eq 'open' || die "$lowstate ?";
1618 length($action) || die;
1619 $ref == $sref || die "read $sref but saving $ref ?";
1620 append_action_to_log(bug => $ref,
1622 requester => $header{from},
1623 request_addr => $controlrequestaddr,
1627 unlockwritebug($ref, $data);
1634 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1639 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1646 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1647 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1653 print {$transcript} "\n";
1659 print {$transcript} "\n";
1665 sub sendtxthelpraw {
1666 my ($relpath,$description) = @_;
1668 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1669 while(<D>) { $doc.=$_; }
1671 print {$transcript} "Sending $description in separate message.\n";
1672 &sendmailmessage(<<END.$doc,$replyto);
1673 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1675 Subject: $gProject $gBug help: $description
1676 References: $header{'message-id'}
1677 In-Reply-To: $header{'message-id'}
1678 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1680 X-$gProject-PR-Message: doc-text $relpath
1686 sub sendlynxdocraw {
1687 my ($relpath,$description) = @_;
1689 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1690 while(<L>) { $doc.=$_; }
1692 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1693 print {$transcript} "Information ($description) is not available -\n".
1694 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1697 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1699 print {$transcript} "Sending $description.\n";
1700 &sendmailmessage(<<END.$doc,$replyto);
1701 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1703 Subject: $gProject $gBugs information: $description
1704 References: $header{'message-id'}
1705 In-Reply-To: $header{'message-id'}
1706 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1708 X-$gProject-PR-Message: doc-html $relpath
1717 my ($wherefrom,$path,$description) = @_;
1718 if ($wherefrom eq "ftp.d.o") {
1719 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1721 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1722 print {$transcript} "$description is not available.\n";
1725 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1728 } elsif ($wherefrom eq "local") {
1730 $doc = do { local $/; <P> };
1733 print {$transcript} "internal errror: info files location unknown.\n";
1736 print {$transcript} "Sending $description.\n";
1737 &sendmailmessage(<<END.$doc,$replyto);
1738 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1740 Subject: $gProject $gBugs information: $description
1741 References: $header{'message-id'}
1742 In-Reply-To: $header{'message-id'}
1743 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1745 X-$gProject-PR-Message: getinfo
1747 $description follows:
1751 print {$transcript} "\n";