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
9 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
10 use Debbugs::Mail qw(send_mail_message);
12 use HTML::Entities qw(encode_entities);
13 use Debbugs::Versions::Dpkg;
15 use Debbugs::Config qw(:globals :config);
16 use Debbugs::CGI qw(html_escape);
17 use Debbugs::Control qw(:archive :log);
18 use Debbugs::Log qw(:misc);
20 $lib_path = $gLibPath;
21 require "$lib_path/errorlib";
22 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
24 chdir("$gSpoolDir") || die "chdir spool: $!\n";
27 open DEBUG, ">/dev/null";
32 m/^[RC]\.\d+$/ || &quit("bad argument");
35 if (!rename("incoming/G$nn","incoming/P$nn")) {
36 $_=$!.''; m/no such file or directory/i && exit 0;
37 &quit("renaming to lock: $!");
40 open(M,"incoming/P$nn");
47 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
49 my $parser = new MIME::Parser;
50 mkdir "$gSpoolDir/mime.tmp", 0777;
51 $parser->output_under("$gSpoolDir/mime.tmp");
52 my $entity = eval { $parser->parse_data(join('',@log)) };
54 # header and decoded body respectively
55 my (@headerlines, @bodylines);
56 # Bug numbers to send e-mail to, hash so that we don't send to the
60 if ($entity and $entity->head->tags) {
61 @headerlines = @{$entity->head->header};
64 my $entity_body = getmailbody($entity);
65 @bodylines = $entity_body ? $entity_body->as_lines() : ();
68 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
70 for ($i = 0; $i <= $#msg; $i++) {
72 last unless length($_);
73 while ($msg[$i+1] =~ m/^\s/) {
77 push @headerlines, $_;
80 @bodylines = @msg[$i..$#msg];
84 $_ = decode_rfc1522($_);
86 print ">$_<\n" if $debug;
89 print ">$v=$_<\n" if $debug;
92 print "!>$_<\n" if $debug;
96 # Strip off RFC2440-style PGP clearsigning.
97 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
98 shift @bodylines while @bodylines and length $bodylines[0];
99 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
100 for my $findsig (0 .. $#bodylines) {
101 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
102 $#bodylines = $findsig - 1;
106 map { s/^- // } @bodylines;
109 grep(s/\s+$//,@bodylines);
111 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
113 if (defined $header{'resent-from'} && !defined $header{'from'}) {
114 $header{'from'} = $header{'resent-from'};
117 defined($header{'from'}) || &quit("no From header");
119 delete $header{'reply-to'}
120 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
122 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
123 $replyto = $header{'reply-to'};
125 $replyto = $header{'from'};
128 # This is an error counter which should be incremented every time there is an error.
130 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
132 &transcript("Processing commands for $controlrequestaddr:\n\n");
137 $mergelowstate= 'idle';
143 $user =~ s/^.*<(.*)>.*$/$1/;
144 $user =~ s/[(].*[)]//;
145 $user =~ s/^\s*(\S+)\s+.*$/$1/;
146 $user = "" unless (Debbugs::User::is_valid_user($user));
147 my $indicated_user = 0;
151 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
152 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
153 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
154 &transcript("Have a nice day\n\n.");
163 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
166 for ($procline=0; $procline<=$#bodylines; $procline++) {
167 $state eq 'idle' || print "$state ?\n";
168 $lowstate eq 'idle' || print "$lowstate ?\n";
169 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
171 &transcript("Stopping processing here.\n\n");
174 $_= $bodylines[$procline]; s/\s+$//;
176 &transcript("> $_\n");
179 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
180 &transcript("Stopping processing here.\n\n");
182 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
184 &transcript("Debug level $dl.\n\n");
185 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
187 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
188 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
190 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
191 "detailed logs for $gBug#$ref");
192 } elsif (m/^index(\s+full)?$/i) {
193 &transcript("This BTS function is currently disabled, sorry.\n\n");
195 $ok++; # well, it's not really ok, but it fixes #81224 :)
196 } elsif (m/^index-summary\s+by-package$/i) {
197 &transcript("This BTS function is currently disabled, sorry.\n\n");
199 $ok++; # well, it's not really ok, but it fixes #81224 :)
200 } elsif (m/^index-summary(\s+by-number)?$/i) {
201 &transcript("This BTS function is currently disabled, sorry.\n\n");
203 $ok++; # well, it's not really ok, but it fixes #81224 :)
204 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
205 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
206 } elsif (m/^index(\s+|-)maints?$/i) {
207 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
208 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
210 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
211 "$gBug list for maintainer \`$maint'");
213 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
215 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
216 "$gBug list for package $package");
218 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
219 &transcript("This BTS function is currently disabled, sorry.\n\n");
221 $ok++; # well, it's not really ok, but it fixes #81224 :)
222 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
223 &transcript("This BTS function is currently disabled, sorry.\n\n");
225 $ok++; # well, it's not really ok, but it fixes #81224 :)
226 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
227 &transcript("This BTS function is currently disabled, sorry.\n\n");
229 $ok++; # well, it's not really ok, but it fixes #81224 :)
230 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
231 # the following is basically a Debian-specific kludge, but who cares
233 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
234 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
235 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
237 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
238 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
239 &sendinfo("local", "$gConfigDir/$req", "$req file");
241 &transcript("Info file $req does not exist.\n\n");
243 } elsif (m/^help/i) {
247 } elsif (m/^refcard/i) {
248 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
249 } elsif (m/^subscribe/i) {
251 There is no $gProject $gBug mailing list. If you wish to review bug reports
252 please do so via http://$gWebDomain/ or ask this mail server
254 soon: MAILINGLISTS_TEXT
256 } elsif (m/^unsubscribe/i) {
258 soon: UNSUBSCRIBE_TEXT
259 soon: MAILINGLISTS_TEXT
261 } elsif (m/^user\s+(\S+)\s*$/i) {
263 if (Debbugs::User::is_valid_user($newuser)) {
264 my $olduser = ($user ne "" ? " (was $user)" : "");
265 &transcript("Setting user to $newuser$olduser.\n");
269 &transcript("Selected user id ($newuser) invalid, sorry\n");
274 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
277 my $hidden = ($2 ne "");
284 &transcript("No valid user selected\n");
288 if (not $indicated_user and defined $user) {
289 &transcript("User is $user\n");
292 while (++$procline <= $#bodylines) {
293 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
297 &transcript("> $bodylines[$procline]\n");
299 my ($o, $txt) = ($1, $2);
300 if ($#cats == -1 && $o eq "+") {
301 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
307 unless (ref($cats[-1]) eq "HASH") {
308 $cats[-1] = { "nam" => $cats[-1],
309 "pri" => [], "ttl" => [] };
312 my ($desc, $ord, $op);
313 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
314 $desc = $1; $ord = $3; $op = "";
315 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
316 $desc = $1; $ord = $3; $op = $4;
317 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
318 $desc = ""; $op = $1;
320 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
325 $ord = 999 unless defined $ord;
328 push @{$cats[-1]->{"pri"}}, $prefix . $op;
329 push @{$cats[-1]->{"ttl"}}, $desc;
330 push @ords, "$ord $catsec";
332 @cats[-1]->{"def"} = $desc;
333 push @ords, "$ord DEF";
336 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
337 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
338 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
339 } elsif ($o eq "*") {
342 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
343 $name = $1; $prefix = $3;
345 $name = $txt; $prefix = "";
350 # XXX: got @cats, now do something with it
351 my $u = Debbugs::User::get_user($user);
353 &transcript("Added usercategory $catname.\n\n");
354 $u->{"categories"}->{$catname} = [ @cats ];
356 push @{$u->{visible_cats}},$catname;
359 &transcript("Removed usercategory $catname.\n\n");
360 delete $u->{"categories"}->{$catname};
361 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
364 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
366 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
367 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
368 $ref = $clonebugs{$ref};
371 &transcript("No valid user selected\n");
375 if (not $indicated_user and defined $user) {
376 &transcript("User is $user\n");
381 Debbugs::User::read_usertags(\%ut, $user);
382 my @oldtags = (); my @newtags = (); my @badtags = ();
384 for my $t (split /[,\s]+/, $tags) {
385 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
392 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
395 for my $t (keys %chtags) {
396 $ut{$t} = [] unless defined $ut{$t};
398 for my $t (keys %ut) {
399 my %res = map { ($_, 1) } @{$ut{$t}};
400 push @oldtags, $t if defined $res{$ref};
401 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
402 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
403 : $addsubcode eq "=");
404 $res{$ref} = 1 if ($addop && defined $chtags{$t});
405 delete $res{$ref} if ($del);
406 push @newtags, $t if defined $res{$ref};
407 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
410 &transcript("There were no usertags set.\n");
412 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
414 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
415 Debbugs::User::write_usertags(\%ut, $user);
417 } elsif (!$control) {
419 Unknown command or malformed arguments to command.
420 (Use control\@$gEmailDomain to manipulate reports.)
424 if (++$unknowns >= 3) {
425 &transcript("Too many unknown commands, stopping here.\n\n");
428 #### "developer only" ones start here
429 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
432 $bug_affected{$ref}=1;
435 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
436 if (length($data->{done}) and not defined($version)) {
437 &transcript("$gBug is already closed, cannot re-close.\n\n");
442 "marked as fixed in version $version" :
444 ", send any further explanations to $data->{originator}";
446 &addmaintainers($data);
447 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
448 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
449 $data->{done}= $replyto;
450 my @keywords= split ' ', $data->{keywords};
451 if (grep $_ eq 'pending', @keywords) {
452 $extramessage= "Removed pending tag.\n";
453 $data->{keywords}= join ' ', grep $_ ne 'pending',
456 addfixedversions($data, $data->{package}, $version, 'binary');
459 From: $gMaintainerEmail ($gProject $gBug Tracking System)
460 To: $data->{originator}
461 Subject: $gBug#$ref acknowledged by developer
463 References: $header{'message-id'} $data->{msgid}
464 In-Reply-To: $data->{msgid}
465 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
466 Reply-To: $ref\@$gEmailDomain
467 X-$gProject-PR-Message: they-closed-control $ref
469 This is an automatic notification regarding your $gBug report
470 #$ref: $data->{subject},
471 which was filed against the $data->{package} package.
473 It has been marked as closed by one of the developers, namely
476 You should be hearing from them with a substantive response shortly,
477 in case you haven't already. If not, please contact them directly.
480 (administrator, $gProject $gBugs database)
483 &sendmailmessage($message,$data->{originator});
484 } while (&getnextbug);
487 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
489 $ref= $1; $newpackage= $2;
490 $bug_affected{$ref}=1;
492 $newpackage =~ y/A-Z/a-z/;
494 if (length($data->{package})) {
495 $action= "$gBug reassigned from package \`$data->{package}'".
496 " to \`$newpackage'.";
498 $action= "$gBug assigned to package \`$newpackage'.";
501 &addmaintainers($data);
502 $data->{package}= $newpackage;
503 $data->{found_versions}= [];
504 $data->{fixed_versions}= [];
505 # TODO: what if $newpackage is a source package?
506 addfoundversions($data, $data->{package}, $version, 'binary');
507 &addmaintainers($data);
508 } while (&getnextbug);
510 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
511 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
512 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
513 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
516 $bug_affected{$ref}=1;
518 if (@{$data->{fixed_versions}}) {
519 &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");
521 if (!length($data->{done})) {
522 &transcript("$gBug is already open, cannot reopen.\n\n");
526 $noriginator eq '' ? "$gBug reopened, originator not changed." :
527 "$gBug reopened, originator set to $noriginator.";
529 &addmaintainers($data);
530 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
531 $data->{fixed_versions}= [];
533 } while (&getnextbug);
536 } elsif (m{^found\s+\#?(-?\d+)
537 (?:\s+((?:$config{package_name_re}\/)?
538 $config{package_version_re}))?$}ix) {
543 if (!length($data->{done}) and not defined($version)) {
544 &transcript("$gBug is already open, cannot reopen.\n\n");
550 "$gBug marked as found in version $version." :
553 &addmaintainers($data);
554 # The 'done' field gets a bit weird with version
555 # tracking, because a bug may be closed by multiple
556 # people in different branches. Until we have something
557 # more flexible, we set it every time a bug is fixed,
558 # and clear it when a bug is found in a version greater
559 # than any version in which the bug is fixed or when
560 # a bug is found and there is no fixed version
561 if (defined $version) {
562 my ($version_only) = $version =~ m{([^/]+)$};
563 addfoundversions($data, $data->{package}, $version, 'binary');
564 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
565 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
566 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
567 $action = "$gBug marked as found in version $version and reopened."
568 if length $data->{done};
572 # Versionless found; assume old-style "not fixed at
574 $data->{fixed_versions} = [];
577 } while (&getnextbug);
580 } elsif (m[^notfound\s+\#?(-?\d+)
581 (?:\s+(?:$config{package_name_re}\/)?
582 ($config{package_version_re}))$]ix) {
587 $action= "$gBug marked as not found in version $version.";
588 if (length($data->{done})) {
589 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
592 &addmaintainers($data);
593 removefoundversions($data, $data->{package}, $version, 'binary');
594 } while (&getnextbug);
597 elsif (m[^fixed\s+\#?(-?\d+)\s+
598 ((?:$config{package_name_re}\/)?
599 $config{package_version_re})\s*$]ix) {
606 "$gBug marked as fixed in version $version." :
609 &addmaintainers($data);
610 addfixedversions($data, $data->{package}, $version, 'binary');
611 } while (&getnextbug);
614 elsif (m[^notfixed\s+\#?(-?\d+)\s+
615 ((?:$config{package_name_re}\/)?
616 $config{package_version_re})\s*$]ix) {
623 "$gBug marked as not fixed in version $version." :
626 &addmaintainers($data);
627 removefixedversions($data, $data->{package}, $version, 'binary');
628 } while (&getnextbug);
631 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
632 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
635 $bug_affected{$ref}=1;
636 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
637 $ref = $clonebugs{$ref};
640 if (&checkpkglimit) {
642 &addmaintainers($data);
643 $oldsubmitter= $data->{originator};
644 $data->{originator}= $newsubmitter;
645 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
647 &transcript("$action\n");
648 if (length($data->{done})) {
649 &transcript("(By the way, that $gBug is currently marked as done.)\n");
653 From: $gMaintainerEmail ($gProject $gBug Tracking System)
655 Subject: $gBug#$ref submitter address changed
657 References: $header{'message-id'} $data->{msgid}
658 In-Reply-To: $data->{msgid}
659 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
660 Reply-To: $ref\@$gEmailDomain
661 X-$gProject-PR-Message: submitter-changed $ref
663 The submitter address recorded for your $gBug report
664 #$ref: $data->{subject}
667 The old submitter address for this report was
669 The new submitter address is
672 This change was made by
674 If it was incorrect, please contact them directly.
677 (administrator, $gProject $gBugs database)
680 &sendmailmessage($message,$oldsubmitter);
687 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
689 $ref= $1; $whereto= $2;
690 $bug_affected{$ref}=1;
692 if (length($data->{forwarded})) {
693 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
695 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
697 if (length($data->{done})) {
698 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
701 &addmaintainers($data);
702 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
703 &addccaddress("$gForwardList\@$gListDomain");
705 $data->{forwarded}= $whereto;
706 } while (&getnextbug);
708 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
711 $bug_affected{$ref}=1;
713 if (!length($data->{forwarded})) {
714 &transcript("$gBug is not marked as having been forwarded.\n\n");
717 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
719 &addmaintainers($data);
720 $data->{forwarded}= '';
721 } while (&getnextbug);
724 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
725 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
728 $bug_affected{$ref}=1;
730 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
731 &transcript("Severity level \`$newseverity' is not known.\n".
732 "Recognized are: $gShowSeverities.\n\n");
734 } elsif (exists $gObsoleteSeverities{$newseverity}) {
735 &transcript("Severity level \`$newseverity' is obsolete. " .
736 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
739 $printseverity= $data->{severity};
740 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
741 $action= "Severity set to \`$newseverity' from \`$printseverity'";
743 &addmaintainers($data);
744 if (defined $gStrongList and isstrongseverity($newseverity)) {
745 addbcc("$gStrongList\@$gListDomain");
747 $data->{severity}= $newseverity;
748 } while (&getnextbug);
750 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
752 $ref = $1; $addsubcode = $3; $tags = $4;
753 $bug_affected{$ref}=1;
755 if (defined $addsubcode) {
756 $addsub = "sub" if ($addsubcode eq "-");
757 $addsub = "add" if ($addsubcode eq "+");
758 $addsub = "set" if ($addsubcode eq "=");
762 foreach my $t (split /[\s,]+/, $tags) {
763 if (!grep($_ eq $t, @gTags)) {
770 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
771 "Recognized are: ".join(' ', @gTags).".\n\n");
775 if ($data->{keywords} eq '') {
776 &transcript("There were no tags set.\n");
778 &transcript("Tags were: $data->{keywords}\n");
780 if ($addsub eq "set") {
781 $action= "Tags set to: " . join(", ", @okaytags);
782 } elsif ($addsub eq "add") {
783 $action= "Tags added: " . join(", ", @okaytags);
784 } elsif ($addsub eq "sub") {
785 $action= "Tags removed: " . join(", ", @okaytags);
788 &addmaintainers($data);
789 $data->{keywords} = '' if ($addsub eq "set");
790 # Allow removing obsolete tags.
791 if ($addsub eq "sub") {
792 foreach my $t (@badtags) {
793 $data->{keywords} = join ' ', grep $_ ne $t,
794 split ' ', $data->{keywords};
797 # Now process all other additions and subtractions.
798 foreach my $t (@okaytags) {
799 $data->{keywords} = join ' ', grep $_ ne $t,
800 split ' ', $data->{keywords};
801 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
803 $data->{keywords} =~ s/\s*$//;
804 } while (&getnextbug);
806 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
808 my $bugnum = $2; my $blockers = $4;
810 $addsub = "sub" if ($1 eq "un");
811 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
812 $bugnum = $clonebugs{$bugnum};
817 foreach my $b (split /[\s,]+/, $blockers) {
821 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
822 $ref = $clonebugs{$ref};
826 push @okayblockers, $ref;
828 # add to the list all bugs that are merged with $b,
829 # because all of their data must be kept in sync
830 @thisbugmergelist= split(/ /,$data->{mergedwith});
833 foreach $ref (@thisbugmergelist) {
835 push @okayblockers, $ref;
842 push @badblockers, $ref;
846 push @badblockers, $b;
850 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
856 if ($data->{blockedby} eq '') {
857 &transcript("Was not blocked by any bugs.\n");
859 &transcript("Was blocked by: $data->{blockedby}\n");
861 if ($addsub eq "set") {
862 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
863 } elsif ($addsub eq "add") {
864 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
865 } elsif ($addsub eq "sub") {
866 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
871 &addmaintainers($data);
872 my @oldblockerlist = split ' ', $data->{blockedby};
873 $data->{blockedby} = '' if ($addsub eq "set");
874 foreach my $b (@okayblockers) {
875 $data->{blockedby} = manipset($data->{blockedby}, $b,
879 foreach my $b (@oldblockerlist) {
880 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
881 push @{$removedblocks{$b}}, $ref;
884 foreach my $b (split ' ', $data->{blockedby}) {
885 if (! grep { $_ eq $b } @oldblockerlist) {
886 push @{$addedblocks{$b}}, $ref;
889 } while (&getnextbug);
891 # Now that the blockedby data is updated, change blocks data
892 # to match the changes.
893 foreach $ref (keys %addedblocks) {
895 foreach my $b (@{$addedblocks{$ref}}) {
896 $data->{blocks} = manipset($data->{blocks}, $b, 1);
901 foreach $ref (keys %removedblocks) {
903 foreach my $b (@{$removedblocks{$ref}}) {
904 $data->{blocks} = manipset($data->{blocks}, $b, 0);
910 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
912 $ref= $1; $newtitle= $2;
913 $bug_affected{$ref}=1;
914 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
915 $ref = $clonebugs{$ref};
918 if (&checkpkglimit) {
920 &addmaintainers($data);
921 my $oldtitle = $data->{subject};
922 $data->{subject}= $newtitle;
923 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
925 &transcript("$action\n");
926 if (length($data->{done})) {
927 &transcript("(By the way, that $gBug is currently marked as done.)\n");
936 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
939 $bug_affected{$ref} = 1;
941 if (!length($data->{mergedwith})) {
942 &transcript("$gBug is not marked as being merged with any others.\n\n");
945 $mergelowstate eq 'locked' || die "$mergelowstate ?";
946 $action= "Disconnected #$ref from all other report(s).";
947 @newmergelist= split(/ /,$data->{mergedwith});
949 @bug_affected{@newmergelist} = 1 x @newmergelist;
951 &addmaintainers($data);
952 $data->{mergedwith}= ($ref == $discref) ? ''
953 : join(' ',grep($_ ne $ref,@newmergelist));
954 } while (&getnextbug);
957 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
959 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
960 my @newmergelist= ();
965 while (defined($ref= shift(@tomerge))) {
966 &transcript("D| checking merge $ref\n") if $dl;
968 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
969 $ref = $clonebugs{$ref};
971 next if grep($_ == $ref,@newmergelist);
972 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
973 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
975 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
977 &checkmatch('package','m_package',$data->{package},@newmergelist);
978 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
979 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
980 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
981 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
982 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
983 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
984 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
985 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
986 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
987 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
988 if (length($mismatch)) {
989 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
992 &cancelbug; @newmergelist=(); last;
994 push(@newmergelist,$ref);
995 push(@tomerge,split(/ /,$data->{mergedwith}));
999 @newmergelist= sort { $a <=> $b } @newmergelist;
1000 $action= "Merged @newmergelist.";
1001 delete @fixed{keys %found};
1002 for $ref (@newmergelist) {
1003 &getbug || die "huh ? $gBug $ref disappeared during merge";
1004 &addmaintainers($data);
1005 @bug_affected{@newmergelist} = 1 x @newmergelist;
1006 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1007 $data->{keywords}= join(' ', keys %tags);
1008 $data->{found_versions}= [sort keys %found];
1009 $data->{fixed_versions}= [sort keys %fixed];
1012 &transcript("$action\n\n");
1015 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1017 my @temp = split /\s+\#?/,$1;
1018 my $master_bug = shift @temp;
1019 my $master_bug_data;
1020 my @tomerge = sort { $a <=> $b } @temp;
1021 unshift @tomerge,$master_bug;
1022 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1023 my @newmergelist= ();
1027 # Here we try to do the right thing.
1028 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1029 # If not, we discard the found and fixed.
1030 # Everything else we set to the values of the first bug.
1032 while (defined($ref= shift(@tomerge))) {
1033 &transcript("D| checking merge $ref\n") if $dl;
1035 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1036 $ref = $clonebugs{$ref};
1038 next if grep($_ == $ref,@newmergelist);
1039 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1040 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1042 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1043 $master_bug_data = $data if not defined $master_bug_data;
1044 if ($data->{package} ne $master_bug_data->{package}) {
1045 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1046 "$gBug $ref is not in the same package as $master_bug\n");
1048 &cancelbug; @newmergelist=(); last;
1050 for my $t (split /\s+/,$data->{keywords}) {
1053 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1054 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1055 push(@newmergelist,$ref);
1056 push(@tomerge,split(/ /,$data->{mergedwith}));
1059 if (@newmergelist) {
1060 @newmergelist= sort { $a <=> $b } @newmergelist;
1061 $action= "Forcibly Merged @newmergelist.";
1062 delete @fixed{keys %found};
1063 for $ref (@newmergelist) {
1064 &getbug || die "huh ? $gBug $ref disappeared during merge";
1065 &addmaintainers($data);
1066 @bug_affected{@newmergelist} = 1 x @newmergelist;
1067 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1068 $data->{keywords}= join(' ', keys %tags);
1069 $data->{found_versions}= [sort keys %found];
1070 $data->{fixed_versions}= [sort keys %fixed];
1071 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1072 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1075 &transcript("$action\n\n");
1078 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1082 @newclonedids = split /\s+/, $2;
1083 $newbugsneeded = scalar(@newclonedids);
1086 $bug_affected{$ref} = 1;
1088 if (length($data->{mergedwith})) {
1089 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1093 &filelock("nextnumber.lock");
1094 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1095 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1096 $firstref= $v+0; $v += $newbugsneeded;
1097 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1100 $lastref = $firstref + $newbugsneeded - 1;
1102 if ($newbugsneeded == 1) {
1103 $action= "$gBug $origref cloned as bug $firstref.";
1105 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1108 my $blocks = $data->{blocks};
1109 my $blockedby = $data->{blockedby};
1112 my $ohash = get_hashname($origref);
1113 my $clone = $firstref;
1114 @bug_affected{@newclonedids} = 1 x @newclonedids;
1115 for $newclonedid (@newclonedids) {
1116 $clonebugs{$newclonedid} = $clone;
1118 my $hash = get_hashname($clone);
1119 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1120 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1121 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1122 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1123 &bughook('new', $clone, $data);
1125 # Update blocking info of bugs blocked by or blocking the
1127 foreach $ref (split ' ', $blocks) {
1129 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1132 foreach $ref (split ' ', $blockedby) {
1134 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1142 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1144 my @pkgs = split /\s+/, $1;
1145 if (scalar(@pkgs) > 0) {
1146 %limit_pkgs = map { ($_, 1) } @pkgs;
1147 &transcript("Ignoring bugs not assigned to: " .
1148 join(" ", keys(%limit_pkgs)) . "\n\n");
1151 &transcript("Not ignoring any bugs.\n\n");
1153 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1154 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1157 $bug_affected{$ref} = 1;
1159 if (length $data->{owner}) {
1160 $action = "Owner changed from $data->{owner} to $newowner.";
1162 $action = "Owner recorded as $newowner.";
1164 if (length $data->{done}) {
1165 $extramessage = "(By the way, this $gBug is currently " .
1166 "marked as done.)\n";
1169 &addmaintainers($data);
1170 $data->{owner} = $newowner;
1171 } while (&getnextbug);
1173 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1176 $bug_affected{$ref} = 1;
1178 if (length $data->{owner}) {
1179 $action = "Removed annotation that $gBug was owned by " .
1182 &addmaintainers($data);
1183 $data->{owner} = '';
1184 } while (&getnextbug);
1186 &transcript("$gBug is not marked as having an owner.\n\n");
1190 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1193 $bug_affected{$ref} = 1;
1196 bug_unarchive(bug => $ref,
1197 transcript => \$transcript,
1198 affected_bugs => \%bug_affected,
1199 requester => $header{from},
1200 request_addr => $controlrequestaddr,
1207 transcript($transcript."\n");
1208 } elsif (m/^archive\s+#?(\d+)$/i) {
1211 $bug_affected{$ref} = 1;
1213 if (exists $data->{unarchived}) {
1217 bug_archive(bug => $ref,
1218 transcript => \$transcript,
1220 affected_bugs => \%bug_affected,
1221 requester => $header{from},
1222 request_addr => $controlrequestaddr,
1229 transcript($transcript."\n");
1232 transcript("$gBug $ref has not been archived previously\n\n");
1238 &transcript("Unknown command or malformed arguments to command.\n\n");
1240 if (++$unknowns >= 5) {
1241 &transcript("Too many unknown commands, stopping here.\n\n");
1246 if ($procline>$#bodylines) {
1247 &transcript(">\nEnd of message, stopping processing here.\n\n");
1249 if (!$ok && !quickabort) {
1251 &transcript("No commands successfully parsed; sending the help text(s).\n");
1256 &transcript("MC\n") if $dl>1;
1258 for $maint (keys %maintccreasons) {
1259 &transcript("MM|$maint|\n") if $dl>1;
1260 next if $maint eq $replyto;
1262 $reasonsref= $maintccreasons{$maint};
1263 &transcript("MY|$maint|\n") if $dl>2;
1264 for $p (sort keys %$reasonsref) {
1265 &transcript("MP|$p|\n") if $dl>2;
1266 $reasonstring.= ', ' if length($reasonstring);
1267 $reasonstring.= $p.' ' if length($p);
1268 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1270 if (length($reasonstring) > 40) {
1271 (substr $reasonstring, 37) = "...";
1273 $reasonstring = "" if (!defined($reasonstring));
1274 push(@maintccs,"$maint ($reasonstring)");
1275 push(@maintccaddrs,"$maint");
1280 &transcript("MC|@maintccs|\n") if $dl>2;
1281 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1285 for my $maint (keys %maintccreasons) {
1286 for my $package (keys %{$maintccreasons{$maint}}) {
1287 next unless length $package;
1288 $packagepr{$package} = 1;
1292 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1294 # Add Bcc's to subscribed bugs
1295 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1297 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1298 $header{'subject'} = "your mail";
1301 # Error text here advertises how many errors there were
1302 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1305 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1307 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1308 In-Reply-To: $header{'message-id'}
1309 References: $header{'message-id'}
1310 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1312 ${packagepr}X-$gProject-PR-Message: transcript
1314 ${transcript}Please contact me if you need assistance.
1317 (administrator, $gProject $gBugs database)
1321 $repliedshow= join(', ',$replyto,@maintccaddrs);
1322 # -1 is the service.in log
1323 &filelock("lock/-1");
1324 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1326 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1328 "<strong>Request received</strong> from <code>".
1329 html_escape($header{'from'})."</code>\n".
1330 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1332 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1333 close(AP) || &quit("open db-h/-1.log: $!");
1335 utime(time,time,"db-h");
1337 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1339 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1341 sub sendmailmessage {
1342 local ($message,@recips) = @_;
1343 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1344 send_mail_message(message => $message,
1345 recipients => \@recips,
1351 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1352 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1356 #sub unimplemented {
1357 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1361 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1363 if (@newmergelist) {
1364 eval "\$mvarvalue= \$$mvarname";
1365 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1368 "Values for \`$string' don't match:\n".
1369 " #$newmergelist[0] has \`$mvarvalue';\n".
1370 " #$ref has \`$svarvalue'\n"
1371 if $mvarvalue ne $svarvalue;
1373 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1375 eval "\$$mvarname= \$svarvalue";
1380 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1381 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1393 my %h = map { $_ => 1 } split ' ', $list;
1400 return join ' ', sort keys %h;
1403 # High-level bug manipulation calls
1404 # Do announcements themselves
1406 # Possible calling sequences:
1407 # setbug (returns 0)
1409 # setbug (returns 1)
1410 # &transcript(something)
1413 # setbug (returns 1)
1414 # $action= (something)
1416 # (modify s_* variables)
1417 # } while (getnextbug);
1420 &dlen("nochangebug");
1421 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1423 &endmerge if $manybugs;
1425 &dlex("nochangebug");
1429 &dlen("setbug $ref");
1430 if ($ref =~ m/^-\d+/) {
1431 if (!defined $clonebugs{$ref}) {
1433 &dlex("setbug => noclone");
1436 $ref = $clonebugs{$ref};
1438 $state eq 'idle' || die "$state ?";
1441 &dlex("setbug => 0s");
1445 if (!&checkpkglimit) {
1450 @thisbugmergelist= split(/ /,$data->{mergedwith});
1451 if (!@thisbugmergelist) {
1456 &dlex("setbug => 1s");
1465 &dlex("setbug => 0mc");
1469 $state= 'multiple'; $sref=$ref;
1470 &dlex("setbug => 1m");
1475 &dlen("getnextbug");
1476 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1478 if (!$manybugs || !@thisbugmergelist) {
1479 length($action) || die;
1480 &transcript("$action\n$extramessage\n");
1481 &endmerge if $manybugs;
1483 &dlex("getnextbug => 0");
1486 $ref= shift(@thisbugmergelist);
1487 &getbug || die "bug $ref disappeared";
1489 &dlex("getnextbug => 1");
1493 # Low-level bug-manipulation calls
1494 # Do no announcements
1496 # getbug (returns 0)
1498 # getbug (returns 1)
1502 # $action= (something)
1503 # getbug (returns 1)
1505 # getbug (returns 1)
1507 # [getbug (returns 0)]
1508 # &transcript("$action\n\n")
1511 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1512 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1516 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1517 &filelock('lock/merge');
1518 $mergelowstate='locked';
1524 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1526 $mergelowstate='idle';
1531 &dlen("getbug $ref");
1532 $lowstate eq 'idle' || die "$state ?";
1533 # Only use unmerged bugs here
1534 if (($data = &lockreadbug($ref,'db-h'))) {
1537 &dlex("getbug => 1");
1542 &dlex("getbug => 0");
1548 $lowstate eq 'open' || die "$state ?";
1555 &dlen("savebug $ref");
1556 $lowstate eq 'open' || die "$lowstate ?";
1557 length($action) || die;
1558 $ref == $sref || die "read $sref but saving $ref ?";
1559 append_action_to_log(bug => $ref,
1561 requester => $header{from},
1562 request_addr => $controlrequestaddr,
1566 unlockwritebug($ref, $data);
1573 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1578 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1582 print $_[0] if $debug;
1583 $transcript.= $_[0];
1590 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1591 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1607 sub sendtxthelpraw {
1608 local ($relpath,$description) = @_;
1610 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1611 while(<D>) { $doc.=$_; }
1613 &transcript("Sending $description in separate message.\n");
1614 &sendmailmessage(<<END.$doc,$replyto);
1615 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1617 Subject: $gProject $gBug help: $description
1618 References: $header{'message-id'}
1619 In-Reply-To: $header{'message-id'}
1620 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1622 X-$gProject-PR-Message: doc-text $relpath
1628 sub sendlynxdocraw {
1629 local ($relpath,$description) = @_;
1631 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1632 while(<L>) { $doc.=$_; }
1634 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1635 &transcript("Information ($description) is not available -\n".
1636 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1639 &transcript("Error getting $description (code $? $!):\n$doc\n");
1641 &transcript("Sending $description.\n");
1642 &sendmailmessage(<<END.$doc,$replyto);
1643 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1645 Subject: $gProject $gBugs information: $description
1646 References: $header{'message-id'}
1647 In-Reply-To: $header{'message-id'}
1648 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1650 X-$gProject-PR-Message: doc-html $relpath
1659 $maintccreasons{$cca}{''}{$ref}= 1;
1662 sub addmaintainers {
1663 # Data structure is:
1664 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1667 &ensuremaintainersloaded;
1668 $anymaintfound=0; $anymaintnotfound=0;
1669 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1671 $p =~ /([a-z0-9.+-]+)/;
1673 next unless defined $p;
1674 if (defined $gSubscriptionDomain) {
1675 if (defined($pkgsrc{$p})) {
1676 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1678 addbcc("$p\@$gSubscriptionDomain");
1681 if (defined $data->{severity} and defined $gStrongList and
1682 isstrongseverity($data->{severity})) {
1683 addbcc("$gStrongList\@$gListDomain");
1685 if (defined($maintainerof{$p})) {
1686 $addmaint= $maintainerof{$p};
1687 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1688 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1689 print "maintainer add >$p|$addmaint<\n" if $debug;
1691 print "maintainer none >$p<\n" if $debug;
1692 &transcript("Warning: Unknown package '$p'\n");
1693 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1694 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1698 if (length $data->{owner}) {
1699 $addmaint = $data->{owner};
1700 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1701 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1702 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1706 sub ensuremaintainersloaded {
1708 return if $maintainersloaded++;
1709 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1713 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1714 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1715 $maintainerof{$a}= $2;
1718 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1722 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1723 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1724 $maintainerof{$a}= $2;
1727 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1729 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1730 my ($a, $b) = ($1, $2);
1731 $pkgsrc{lc($a)} = $b;
1737 local ($wherefrom,$path,$description) = @_;
1738 if ($wherefrom eq "ftp.d.o") {
1739 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1741 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1742 &transcript("$description is not available.\n");
1745 &transcript("Error getting $description (code $? $!):\n$doc\n");
1748 } elsif ($wherefrom eq "local") {
1750 $doc = do { local $/; <P> };
1753 &transcript("internal errror: info files location unknown.\n");
1756 &transcript("Sending $description.\n");
1757 &sendmailmessage(<<END.$doc,$replyto);
1758 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1760 Subject: $gProject $gBugs information: $description
1761 References: $header{'message-id'}
1762 In-Reply-To: $header{'message-id'}
1763 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1765 X-$gProject-PR-Message: getinfo
1767 $description follows: