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 :owner);
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/^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/i) {
1191 if ($newowner eq '!') {
1192 $newowner = $replyto;
1194 $bug_affected{$ref} = 1;
1197 transcript => $transcript,
1198 ($dl > 0 ? (debug => $transcript):()),
1199 requester => $header{from},
1200 request_addr => $controlrequestaddr,
1202 recipients => \%recipients,
1206 } elsif (m/^noowner\s+\#?(-?\d+)\s*$/i) {
1209 $bug_affected{$ref} = 1;
1212 transcript => $transcript,
1213 ($dl > 0 ? (debug => $transcript):()),
1214 requester => $header{from},
1215 request_addr => $controlrequestaddr,
1217 recipients => \%recipients,
1223 print {$transcript} "Failed to mark $ref as not having an owner: $@";
1225 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1228 $bug_affected{$ref} = 1;
1230 bug_unarchive(bug => $ref,
1231 transcript => $transcript,
1232 ($dl > 0 ? (debug => $transcript):()),
1233 affected_bugs => \%bug_affected,
1234 requester => $header{from},
1235 request_addr => $controlrequestaddr,
1237 recipients => \%recipients,
1243 } elsif (m/^archive\s+#?(\d+)$/i) {
1246 $bug_affected{$ref} = 1;
1248 bug_archive(bug => $ref,
1249 transcript => $transcript,
1250 ($dl > 0 ? (debug => $transcript):()),
1252 archive_unarchived => 0,
1253 affected_bugs => \%bug_affected,
1254 requester => $header{from},
1255 request_addr => $controlrequestaddr,
1257 recipients => \%recipients,
1264 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1266 if (++$unknowns >= 5) {
1267 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1272 if ($procline>$#bodylines) {
1273 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1275 if (!$ok && !$quickabort) {
1277 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1279 print {$transcript} "\n";
1282 my @maintccs = determine_recipients(recipients => \%recipients,
1286 my $maintccs = 'Cc: '.join(",\n ",
1287 determine_recipients(recipients => \%recipients,
1293 $packagepr = "X-${gProject}-PR-Package: " . join(keys %affected_packages) . "\n" if keys %affected_packages;
1295 # Add Bcc's to subscribed bugs
1296 # now handled by Debbugs::Recipients
1297 #push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1299 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1300 $header{'subject'} = "your mail";
1303 # Error text here advertises how many errors there were
1304 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1307 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1309 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1310 In-Reply-To: $header{'message-id'}
1313 References: $header{'message-id'}
1314 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1316 ${packagepr}X-$gProject-PR-Message: transcript
1318 ${transcript_scalar}Please contact me if you need assistance.
1321 (administrator, $gProject $gBugs database)
1324 my $repliedshow= join(', ',$replyto,
1325 determine_recipients(recipients => \%recipients,
1330 # -1 is the service.in log
1331 &filelock("lock/-1");
1332 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1334 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1336 "<strong>Request received</strong> from <code>".
1337 html_escape($header{'from'})."</code>\n".
1338 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1340 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1341 close(AP) || die "open db-h/-1.log: $!";
1343 utime(time,time,"db-h");
1345 &sendmailmessage($reply,
1346 exists $header{'x-debbugs-no-ack'}?():$replyto,
1347 make_list(values %{{determine_recipients(recipients => \%recipients,
1353 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1355 sub sendmailmessage {
1356 my ($message,@recips) = @_;
1357 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1358 send_mail_message(message => $message,
1359 recipients => \@recips,
1365 my ($template,$extra_var) = @_;
1367 my $variables = {config => \%config,
1368 defined($ref)?(ref => $ref):(),
1369 defined($data)?(data => $data):(),
1372 my $hole_var = {'&bugurl' =>
1374 'http://'.$config{cgi_domain}.'/'.
1375 Debbugs::CGI::bug_url($_[0]);
1378 return fill_in_template(template => $template,
1379 variables => $variables,
1380 hole_var => $hole_var,
1384 =head2 message_body_template
1386 message_body_template('mail/ack',{ref=>'foo'});
1388 Creates a message body using a template
1392 sub message_body_template{
1393 my ($template,$extra_var) = @_;
1395 my $body = fill_template($template,$extra_var);
1396 return fill_template('mail/message_body',
1404 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1405 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1409 #sub unimplemented {
1410 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1414 my ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1416 if (@newmergelist) {
1417 eval "\$mvarvalue= \$$mvarname";
1418 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1421 "Values for \`$string' don't match:\n".
1422 " #$newmergelist[0] has \`$mvarvalue';\n".
1423 " #$ref has \`$svarvalue'\n"
1424 if $mvarvalue ne $svarvalue;
1426 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1428 eval "\$$mvarname= \$svarvalue";
1433 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1434 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1446 my %h = map { $_ => 1 } split ' ', $list;
1453 return join ' ', sort keys %h;
1456 # High-level bug manipulation calls
1457 # Do announcements themselves
1459 # Possible calling sequences:
1460 # setbug (returns 0)
1462 # setbug (returns 1)
1463 # &transcript(something)
1466 # setbug (returns 1)
1467 # $action= (something)
1469 # (modify s_* variables)
1470 # } while (getnextbug);
1475 &dlen("nochangebug");
1476 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1478 &endmerge if $manybugs;
1480 &dlex("nochangebug");
1484 our @thisbugmergelist;
1487 &dlen("setbug $ref");
1488 if ($ref =~ m/^-\d+/) {
1489 if (!defined $clonebugs{$ref}) {
1491 &dlex("setbug => noclone");
1494 $ref = $clonebugs{$ref};
1496 $state eq 'idle' || die "$state ?";
1499 &dlex("setbug => 0s");
1503 if (!&checkpkglimit) {
1508 @thisbugmergelist= split(/ /,$data->{mergedwith});
1509 if (!@thisbugmergelist) {
1514 &dlex("setbug => 1s");
1523 &dlex("setbug => 0mc");
1527 $state= 'multiple'; $sref=$ref;
1528 &dlex("setbug => 1m");
1533 &dlen("getnextbug");
1534 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1536 if (!$manybugs || !@thisbugmergelist) {
1537 length($action) || die;
1538 print {$transcript} "$action\n$extramessage\n";
1539 &endmerge if $manybugs;
1541 &dlex("getnextbug => 0");
1544 $ref= shift(@thisbugmergelist);
1545 &getbug || die "bug $ref disappeared";
1547 &dlex("getnextbug => 1");
1551 # Low-level bug-manipulation calls
1552 # Do no announcements
1554 # getbug (returns 0)
1556 # getbug (returns 1)
1560 # $action= (something)
1561 # getbug (returns 1)
1563 # getbug (returns 1)
1565 # [getbug (returns 0)]
1566 # &transcript("$action\n\n")
1569 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1570 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1574 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1575 &filelock('lock/merge');
1576 $mergelowstate='locked';
1582 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1584 $mergelowstate='idle';
1589 &dlen("getbug $ref");
1590 $lowstate eq 'idle' || die "$state ?";
1591 # Only use unmerged bugs here
1592 if (($data = &lockreadbug($ref,'db-h'))) {
1595 &dlex("getbug => 1");
1600 &dlex("getbug => 0");
1606 $lowstate eq 'open' || die "$state ?";
1613 &dlen("savebug $ref");
1614 $lowstate eq 'open' || die "$lowstate ?";
1615 length($action) || die;
1616 $ref == $sref || die "read $sref but saving $ref ?";
1617 append_action_to_log(bug => $ref,
1619 requester => $header{from},
1620 request_addr => $controlrequestaddr,
1624 unlockwritebug($ref, $data);
1631 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1636 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1643 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1644 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1650 print {$transcript} "\n";
1656 print {$transcript} "\n";
1662 sub sendtxthelpraw {
1663 my ($relpath,$description) = @_;
1665 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1666 while(<D>) { $doc.=$_; }
1668 print {$transcript} "Sending $description in separate message.\n";
1669 &sendmailmessage(<<END.$doc,$replyto);
1670 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1672 Subject: $gProject $gBug help: $description
1673 References: $header{'message-id'}
1674 In-Reply-To: $header{'message-id'}
1675 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1677 X-$gProject-PR-Message: doc-text $relpath
1683 sub sendlynxdocraw {
1684 my ($relpath,$description) = @_;
1686 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1687 while(<L>) { $doc.=$_; }
1689 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1690 print {$transcript} "Information ($description) is not available -\n".
1691 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1694 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1696 print {$transcript} "Sending $description.\n";
1697 &sendmailmessage(<<END.$doc,$replyto);
1698 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1700 Subject: $gProject $gBugs information: $description
1701 References: $header{'message-id'}
1702 In-Reply-To: $header{'message-id'}
1703 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1705 X-$gProject-PR-Message: doc-html $relpath
1714 my ($wherefrom,$path,$description) = @_;
1715 if ($wherefrom eq "ftp.d.o") {
1716 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1718 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1719 print {$transcript} "$description is not available.\n";
1722 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1725 } elsif ($wherefrom eq "local") {
1727 $doc = do { local $/; <P> };
1730 print {$transcript} "internal errror: info files location unknown.\n";
1733 print {$transcript} "Sending $description.\n";
1734 &sendmailmessage(<<END.$doc,$replyto);
1735 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1737 Subject: $gProject $gBugs information: $description
1738 References: $header{'message-id'}
1739 In-Reply-To: $header{'message-id'}
1740 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1742 X-$gProject-PR-Message: getinfo
1744 $description follows:
1748 print {$transcript} "\n";