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");
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");
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)) {
570 # Versionless found; assume old-style "not fixed at
572 $data->{fixed_versions} = [];
575 } while (&getnextbug);
578 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
583 $action= "$gBug marked as not found in version $version.";
584 if (length($data->{done})) {
585 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
588 &addmaintainers($data);
589 removefoundversions($data, $data->{package}, $version, 'binary');
590 } while (&getnextbug);
593 elsif (m[^fixed\s+\#?(-?\d+)\s+
594 ((?:$config{package_name_re}\/)?
595 $config{package_version_re})\s*$]ix) {
602 "$gBug marked as fixed in version $version." :
605 &addmaintainers($data);
606 addfixedversions($data, $data->{package}, $version, 'binary');
607 } while (&getnextbug);
610 elsif (m[^notfixed\s+\#?(-?\d+)\s+
611 ((?:$config{package_name_re}\/)?
612 $config{package_version_re})\s*$]ix) {
619 "$gBug marked as not fixed in version $version." :
622 &addmaintainers($data);
623 removefixedversions($data, $data->{package}, $version, 'binary');
624 } while (&getnextbug);
627 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
628 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
631 $bug_affected{$ref}=1;
632 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
633 $ref = $clonebugs{$ref};
636 if (&checkpkglimit) {
638 &addmaintainers($data);
639 $oldsubmitter= $data->{originator};
640 $data->{originator}= $newsubmitter;
641 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
643 &transcript("$action\n");
644 if (length($data->{done})) {
645 &transcript("(By the way, that $gBug is currently marked as done.)\n");
649 From: $gMaintainerEmail ($gProject $gBug Tracking System)
651 Subject: $gBug#$ref submitter address changed
653 References: $header{'message-id'} $data->{msgid}
654 In-Reply-To: $data->{msgid}
655 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
656 Reply-To: $ref\@$gEmailDomain
657 X-$gProject-PR-Message: submitter-changed $ref
659 The submitter address recorded for your $gBug report
660 #$ref: $data->{subject}
663 The old submitter address for this report was
665 The new submitter address is
668 This change was made by
670 If it was incorrect, please contact them directly.
673 (administrator, $gProject $gBugs database)
676 &sendmailmessage($message,$oldsubmitter);
683 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
685 $ref= $1; $whereto= $2;
686 $bug_affected{$ref}=1;
688 if (length($data->{forwarded})) {
689 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
691 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
693 if (length($data->{done})) {
694 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
697 &addmaintainers($data);
698 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
699 &addccaddress("$gForwardList\@$gListDomain");
701 $data->{forwarded}= $whereto;
702 } while (&getnextbug);
704 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
707 $bug_affected{$ref}=1;
709 if (!length($data->{forwarded})) {
710 &transcript("$gBug is not marked as having been forwarded.\n\n");
713 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
715 &addmaintainers($data);
716 $data->{forwarded}= '';
717 } while (&getnextbug);
720 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
721 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
724 $bug_affected{$ref}=1;
726 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
727 &transcript("Severity level \`$newseverity' is not known.\n".
728 "Recognized are: $gShowSeverities.\n\n");
730 } elsif (exists $gObsoleteSeverities{$newseverity}) {
731 &transcript("Severity level \`$newseverity' is obsolete. " .
732 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
735 $printseverity= $data->{severity};
736 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
737 $action= "Severity set to \`$newseverity' from \`$printseverity'";
739 &addmaintainers($data);
740 if (defined $gStrongList and isstrongseverity($newseverity)) {
741 addbcc("$gStrongList\@$gListDomain");
743 $data->{severity}= $newseverity;
744 } while (&getnextbug);
746 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
748 $ref = $1; $addsubcode = $3; $tags = $4;
749 $bug_affected{$ref}=1;
751 if (defined $addsubcode) {
752 $addsub = "sub" if ($addsubcode eq "-");
753 $addsub = "add" if ($addsubcode eq "+");
754 $addsub = "set" if ($addsubcode eq "=");
758 foreach my $t (split /[\s,]+/, $tags) {
759 if (!grep($_ eq $t, @gTags)) {
766 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
767 "Recognized are: ".join(' ', @gTags).".\n\n");
771 if ($data->{keywords} eq '') {
772 &transcript("There were no tags set.\n");
774 &transcript("Tags were: $data->{keywords}\n");
776 if ($addsub eq "set") {
777 $action= "Tags set to: " . join(", ", @okaytags);
778 } elsif ($addsub eq "add") {
779 $action= "Tags added: " . join(", ", @okaytags);
780 } elsif ($addsub eq "sub") {
781 $action= "Tags removed: " . join(", ", @okaytags);
784 &addmaintainers($data);
785 $data->{keywords} = '' if ($addsub eq "set");
786 # Allow removing obsolete tags.
787 if ($addsub eq "sub") {
788 foreach my $t (@badtags) {
789 $data->{keywords} = join ' ', grep $_ ne $t,
790 split ' ', $data->{keywords};
793 # Now process all other additions and subtractions.
794 foreach my $t (@okaytags) {
795 $data->{keywords} = join ' ', grep $_ ne $t,
796 split ' ', $data->{keywords};
797 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
799 $data->{keywords} =~ s/\s*$//;
800 } while (&getnextbug);
802 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
804 my $bugnum = $2; my $blockers = $4;
806 $addsub = "sub" if ($1 eq "un");
807 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
808 $bugnum = $clonebugs{$bugnum};
813 foreach my $b (split /[\s,]+/, $blockers) {
817 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
818 $ref = $clonebugs{$ref};
822 push @okayblockers, $ref;
824 # add to the list all bugs that are merged with $b,
825 # because all of their data must be kept in sync
826 @thisbugmergelist= split(/ /,$data->{mergedwith});
829 foreach $ref (@thisbugmergelist) {
831 push @okayblockers, $ref;
838 push @badblockers, $ref;
842 push @badblockers, $b;
846 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
852 if ($data->{blockedby} eq '') {
853 &transcript("Was not blocked by any bugs.\n");
855 &transcript("Was blocked by: $data->{blockedby}\n");
857 if ($addsub eq "set") {
858 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
859 } elsif ($addsub eq "add") {
860 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
861 } elsif ($addsub eq "sub") {
862 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
867 &addmaintainers($data);
868 my @oldblockerlist = split ' ', $data->{blockedby};
869 $data->{blockedby} = '' if ($addsub eq "set");
870 foreach my $b (@okayblockers) {
871 $data->{blockedby} = manipset($data->{blockedby}, $b,
875 foreach my $b (@oldblockerlist) {
876 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
877 push @{$removedblocks{$b}}, $ref;
880 foreach my $b (split ' ', $data->{blockedby}) {
881 if (! grep { $_ eq $b } @oldblockerlist) {
882 push @{$addedblocks{$b}}, $ref;
885 } while (&getnextbug);
887 # Now that the blockedby data is updated, change blocks data
888 # to match the changes.
889 foreach $ref (keys %addedblocks) {
891 foreach my $b (@{$addedblocks{$ref}}) {
892 $data->{blocks} = manipset($data->{blocks}, $b, 1);
897 foreach $ref (keys %removedblocks) {
899 foreach my $b (@{$removedblocks{$ref}}) {
900 $data->{blocks} = manipset($data->{blocks}, $b, 0);
906 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
908 $ref= $1; $newtitle= $2;
909 $bug_affected{$ref}=1;
910 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
911 $ref = $clonebugs{$ref};
914 if (&checkpkglimit) {
916 &addmaintainers($data);
917 my $oldtitle = $data->{subject};
918 $data->{subject}= $newtitle;
919 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
921 &transcript("$action\n");
922 if (length($data->{done})) {
923 &transcript("(By the way, that $gBug is currently marked as done.)\n");
932 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
935 $bug_affected{$ref} = 1;
937 if (!length($data->{mergedwith})) {
938 &transcript("$gBug is not marked as being merged with any others.\n\n");
941 $mergelowstate eq 'locked' || die "$mergelowstate ?";
942 $action= "Disconnected #$ref from all other report(s).";
943 @newmergelist= split(/ /,$data->{mergedwith});
945 @bug_affected{@newmergelist} = 1 x @newmergelist;
947 &addmaintainers($data);
948 $data->{mergedwith}= ($ref == $discref) ? ''
949 : join(' ',grep($_ ne $ref,@newmergelist));
950 } while (&getnextbug);
953 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
955 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
956 my @newmergelist= ();
961 while (defined($ref= shift(@tomerge))) {
962 &transcript("D| checking merge $ref\n") if $dl;
964 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
965 $ref = $clonebugs{$ref};
967 next if grep($_ == $ref,@newmergelist);
968 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
969 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
971 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
973 &checkmatch('package','m_package',$data->{package},@newmergelist);
974 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
975 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
976 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
977 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
978 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
979 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
980 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
981 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
982 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
983 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
984 if (length($mismatch)) {
985 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
988 &cancelbug; @newmergelist=(); last;
990 push(@newmergelist,$ref);
991 push(@tomerge,split(/ /,$data->{mergedwith}));
995 @newmergelist= sort { $a <=> $b } @newmergelist;
996 $action= "Merged @newmergelist.";
997 delete @fixed{keys %found};
998 for $ref (@newmergelist) {
999 &getbug || die "huh ? $gBug $ref disappeared during merge";
1000 &addmaintainers($data);
1001 @bug_affected{@newmergelist} = 1 x @newmergelist;
1002 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1003 $data->{keywords}= join(' ', keys %tags);
1004 $data->{found_versions}= [sort keys %found];
1005 $data->{fixed_versions}= [sort keys %fixed];
1008 &transcript("$action\n\n");
1011 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1013 my @temp = split /\s+\#?/,$1;
1014 my $master_bug = shift @temp;
1015 my $master_bug_data;
1016 my @tomerge = sort { $a <=> $b } @temp;
1017 unshift @tomerge,$master_bug;
1018 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1019 my @newmergelist= ();
1023 # Here we try to do the right thing.
1024 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1025 # If not, we discard the found and fixed.
1026 # Everything else we set to the values of the first bug.
1028 while (defined($ref= shift(@tomerge))) {
1029 &transcript("D| checking merge $ref\n") if $dl;
1031 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1032 $ref = $clonebugs{$ref};
1034 next if grep($_ == $ref,@newmergelist);
1035 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1036 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1038 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1039 $master_bug_data = $data if not defined $master_bug_data;
1040 if ($data->{package} ne $master_bug_data->{package}) {
1041 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1042 "$gBug $ref is not in the same package as $master_bug\n");
1044 &cancelbug; @newmergelist=(); last;
1046 for my $t (split /\s+/,$data->{keywords}) {
1049 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1050 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1051 push(@newmergelist,$ref);
1052 push(@tomerge,split(/ /,$data->{mergedwith}));
1055 if (@newmergelist) {
1056 @newmergelist= sort { $a <=> $b } @newmergelist;
1057 $action= "Forcibly Merged @newmergelist.";
1058 delete @fixed{keys %found};
1059 for $ref (@newmergelist) {
1060 &getbug || die "huh ? $gBug $ref disappeared during merge";
1061 &addmaintainers($data);
1062 @bug_affected{@newmergelist} = 1 x @newmergelist;
1063 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1064 $data->{keywords}= join(' ', keys %tags);
1065 $data->{found_versions}= [sort keys %found];
1066 $data->{fixed_versions}= [sort keys %fixed];
1067 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1068 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1071 &transcript("$action\n\n");
1074 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1078 @newclonedids = split /\s+/, $2;
1079 $newbugsneeded = scalar(@newclonedids);
1082 $bug_affected{$ref} = 1;
1084 if (length($data->{mergedwith})) {
1085 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1089 &filelock("nextnumber.lock");
1090 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1091 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1092 $firstref= $v+0; $v += $newbugsneeded;
1093 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1096 $lastref = $firstref + $newbugsneeded - 1;
1098 if ($newbugsneeded == 1) {
1099 $action= "$gBug $origref cloned as bug $firstref.";
1101 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1104 my $blocks = $data->{blocks};
1105 my $blockedby = $data->{blockedby};
1108 my $ohash = get_hashname($origref);
1109 my $clone = $firstref;
1110 @bug_affected{@newclonedids} = 1 x @newclonedids;
1111 for $newclonedid (@newclonedids) {
1112 $clonebugs{$newclonedid} = $clone;
1114 my $hash = get_hashname($clone);
1115 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1116 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1117 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1118 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1119 &bughook('new', $clone, $data);
1121 # Update blocking info of bugs blocked by or blocking the
1123 foreach $ref (split ' ', $blocks) {
1125 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1128 foreach $ref (split ' ', $blockedby) {
1130 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1138 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1140 my @pkgs = split /\s+/, $1;
1141 if (scalar(@pkgs) > 0) {
1142 %limit_pkgs = map { ($_, 1) } @pkgs;
1143 &transcript("Ignoring bugs not assigned to: " .
1144 join(" ", keys(%limit_pkgs)) . "\n\n");
1147 &transcript("Not ignoring any bugs.\n\n");
1149 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1150 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1153 $bug_affected{$ref} = 1;
1155 if (length $data->{owner}) {
1156 $action = "Owner changed from $data->{owner} to $newowner.";
1158 $action = "Owner recorded as $newowner.";
1160 if (length $data->{done}) {
1161 $extramessage = "(By the way, this $gBug is currently " .
1162 "marked as done.)\n";
1165 &addmaintainers($data);
1166 $data->{owner} = $newowner;
1167 } while (&getnextbug);
1169 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1172 $bug_affected{$ref} = 1;
1174 if (length $data->{owner}) {
1175 $action = "Removed annotation that $gBug was owned by " .
1178 &addmaintainers($data);
1179 $data->{owner} = '';
1180 } while (&getnextbug);
1182 &transcript("$gBug is not marked as having an owner.\n\n");
1186 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1189 $bug_affected{$ref} = 1;
1192 bug_unarchive(bug => $ref,
1193 transcript => \$transcript,
1194 affected_bugs => \%bug_affected,
1195 requester => $header{from},
1196 request_addr => $controlrequestaddr,
1203 transcript($transcript."\n");
1204 } elsif (m/^archive\s+#?(\d+)$/i) {
1207 $bug_affected{$ref} = 1;
1209 if (exists $data->{unarchived}) {
1213 bug_archive(bug => $ref,
1214 transcript => \$transcript,
1216 affected_bugs => \%bug_affected,
1217 requester => $header{from},
1218 request_addr => $controlrequestaddr,
1225 transcript($transcript."\n");
1228 transcript("$gBug $ref has not been archived previously\n\n");
1234 &transcript("Unknown command or malformed arguments to command.\n\n");
1236 if (++$unknowns >= 5) {
1237 &transcript("Too many unknown commands, stopping here.\n\n");
1242 if ($procline>$#bodylines) {
1243 &transcript(">\nEnd of message, stopping processing here.\n\n");
1245 if (!$ok && !quickabort) {
1247 &transcript("No commands successfully parsed; sending the help text(s).\n");
1252 &transcript("MC\n") if $dl>1;
1254 for $maint (keys %maintccreasons) {
1255 &transcript("MM|$maint|\n") if $dl>1;
1256 next if $maint eq $replyto;
1258 $reasonsref= $maintccreasons{$maint};
1259 &transcript("MY|$maint|\n") if $dl>2;
1260 for $p (sort keys %$reasonsref) {
1261 &transcript("MP|$p|\n") if $dl>2;
1262 $reasonstring.= ', ' if length($reasonstring);
1263 $reasonstring.= $p.' ' if length($p);
1264 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1266 if (length($reasonstring) > 40) {
1267 (substr $reasonstring, 37) = "...";
1269 $reasonstring = "" if (!defined($reasonstring));
1270 push(@maintccs,"$maint ($reasonstring)");
1271 push(@maintccaddrs,"$maint");
1276 &transcript("MC|@maintccs|\n") if $dl>2;
1277 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1281 for my $maint (keys %maintccreasons) {
1282 for my $package (keys %{$maintccreasons{$maint}}) {
1283 next unless length $package;
1284 $packagepr{$package} = 1;
1288 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1290 # Add Bcc's to subscribed bugs
1291 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1293 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1294 $header{'subject'} = "your mail";
1297 # Error text here advertises how many errors there were
1298 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1301 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1303 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1304 In-Reply-To: $header{'message-id'}
1305 References: $header{'message-id'}
1306 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1308 ${packagepr}X-$gProject-PR-Message: transcript
1310 ${transcript}Please contact me if you need assistance.
1313 (administrator, $gProject $gBugs database)
1317 $repliedshow= join(', ',$replyto,@maintccaddrs);
1318 # -1 is the service.in log
1319 &filelock("lock/-1");
1320 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1322 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1324 "<strong>Request received</strong> from <code>".
1325 html_escape($header{'from'})."</code>\n".
1326 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1328 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1329 close(AP) || &quit("open db-h/-1.log: $!");
1331 utime(time,time,"db-h");
1333 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1335 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1337 sub sendmailmessage {
1338 local ($message,@recips) = @_;
1339 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1340 send_mail_message(message => $message,
1341 recipients => \@recips,
1347 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1348 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1352 #sub unimplemented {
1353 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1357 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1359 if (@newmergelist) {
1360 eval "\$mvarvalue= \$$mvarname";
1361 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1364 "Values for \`$string' don't match:\n".
1365 " #$newmergelist[0] has \`$mvarvalue';\n".
1366 " #$ref has \`$svarvalue'\n"
1367 if $mvarvalue ne $svarvalue;
1369 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1371 eval "\$$mvarname= \$svarvalue";
1376 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1377 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1389 my %h = map { $_ => 1 } split ' ', $list;
1396 return join ' ', sort keys %h;
1399 # High-level bug manipulation calls
1400 # Do announcements themselves
1402 # Possible calling sequences:
1403 # setbug (returns 0)
1405 # setbug (returns 1)
1406 # &transcript(something)
1409 # setbug (returns 1)
1410 # $action= (something)
1412 # (modify s_* variables)
1413 # } while (getnextbug);
1416 &dlen("nochangebug");
1417 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1419 &endmerge if $manybugs;
1421 &dlex("nochangebug");
1425 &dlen("setbug $ref");
1426 if ($ref =~ m/^-\d+/) {
1427 if (!defined $clonebugs{$ref}) {
1429 &dlex("setbug => noclone");
1432 $ref = $clonebugs{$ref};
1434 $state eq 'idle' || die "$state ?";
1437 &dlex("setbug => 0s");
1441 if (!&checkpkglimit) {
1446 @thisbugmergelist= split(/ /,$data->{mergedwith});
1447 if (!@thisbugmergelist) {
1452 &dlex("setbug => 1s");
1461 &dlex("setbug => 0mc");
1465 $state= 'multiple'; $sref=$ref;
1466 &dlex("setbug => 1m");
1471 &dlen("getnextbug");
1472 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1474 if (!$manybugs || !@thisbugmergelist) {
1475 length($action) || die;
1476 &transcript("$action\n$extramessage\n");
1477 &endmerge if $manybugs;
1479 &dlex("getnextbug => 0");
1482 $ref= shift(@thisbugmergelist);
1483 &getbug || die "bug $ref disappeared";
1485 &dlex("getnextbug => 1");
1489 # Low-level bug-manipulation calls
1490 # Do no announcements
1492 # getbug (returns 0)
1494 # getbug (returns 1)
1498 # $action= (something)
1499 # getbug (returns 1)
1501 # getbug (returns 1)
1503 # [getbug (returns 0)]
1504 # &transcript("$action\n\n")
1507 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1508 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1512 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1513 &filelock('lock/merge');
1514 $mergelowstate='locked';
1520 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1522 $mergelowstate='idle';
1527 &dlen("getbug $ref");
1528 $lowstate eq 'idle' || die "$state ?";
1529 # Only use unmerged bugs here
1530 if (($data = &lockreadbug($ref,'db-h'))) {
1533 &dlex("getbug => 1");
1538 &dlex("getbug => 0");
1544 $lowstate eq 'open' || die "$state ?";
1551 &dlen("savebug $ref");
1552 $lowstate eq 'open' || die "$lowstate ?";
1553 length($action) || die;
1554 $ref == $sref || die "read $sref but saving $ref ?";
1555 append_action_to_log(bug => $ref,
1557 requester => $header{from},
1558 request_addr => $controlrequestaddr,
1562 unlockwritebug($ref, $data);
1569 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1574 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1578 print $_[0] if $debug;
1579 $transcript.= $_[0];
1586 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1587 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1603 sub sendtxthelpraw {
1604 local ($relpath,$description) = @_;
1606 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1607 while(<D>) { $doc.=$_; }
1609 &transcript("Sending $description in separate message.\n");
1610 &sendmailmessage(<<END.$doc,$replyto);
1611 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1613 Subject: $gProject $gBug help: $description
1614 References: $header{'message-id'}
1615 In-Reply-To: $header{'message-id'}
1616 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1618 X-$gProject-PR-Message: doc-text $relpath
1624 sub sendlynxdocraw {
1625 local ($relpath,$description) = @_;
1627 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1628 while(<L>) { $doc.=$_; }
1630 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1631 &transcript("Information ($description) is not available -\n".
1632 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1635 &transcript("Error getting $description (code $? $!):\n$doc\n");
1637 &transcript("Sending $description.\n");
1638 &sendmailmessage(<<END.$doc,$replyto);
1639 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1641 Subject: $gProject $gBugs information: $description
1642 References: $header{'message-id'}
1643 In-Reply-To: $header{'message-id'}
1644 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1646 X-$gProject-PR-Message: doc-html $relpath
1655 $maintccreasons{$cca}{''}{$ref}= 1;
1658 sub addmaintainers {
1659 # Data structure is:
1660 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1663 &ensuremaintainersloaded;
1664 $anymaintfound=0; $anymaintnotfound=0;
1665 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1667 $p =~ /([a-z0-9.+-]+)/;
1669 next unless defined $p;
1670 if (defined $gSubscriptionDomain) {
1671 if (defined($pkgsrc{$p})) {
1672 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1674 addbcc("$p\@$gSubscriptionDomain");
1677 if (defined $data->{severity} and defined $gStrongList and
1678 isstrongseverity($data->{severity})) {
1679 addbcc("$gStrongList\@$gListDomain");
1681 if (defined($maintainerof{$p})) {
1682 $addmaint= $maintainerof{$p};
1683 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1684 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1685 print "maintainer add >$p|$addmaint<\n" if $debug;
1687 print "maintainer none >$p<\n" if $debug;
1688 &transcript("Warning: Unknown package '$p'\n");
1689 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1690 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1694 if (length $data->{owner}) {
1695 $addmaint = $data->{owner};
1696 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1697 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1698 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1702 sub ensuremaintainersloaded {
1704 return if $maintainersloaded++;
1705 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1709 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1710 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1711 $maintainerof{$a}= $2;
1714 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1718 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1719 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1720 $maintainerof{$a}= $2;
1723 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1725 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1726 my ($a, $b) = ($1, $2);
1727 $pkgsrc{lc($a)} = $b;
1733 local ($wherefrom,$path,$description) = @_;
1734 if ($wherefrom eq "ftp.d.o") {
1735 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1737 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1738 &transcript("$description is not available.\n");
1741 &transcript("Error getting $description (code $? $!):\n$doc\n");
1744 } elsif ($wherefrom eq "local") {
1746 $doc = do { local $/; <P> };
1749 &transcript("internal errror: info files location unknown.\n");
1752 &transcript("Sending $description.\n");
1753 &sendmailmessage(<<END.$doc,$replyto);
1754 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1756 Subject: $gProject $gBugs information: $description
1757 References: $header{'message-id'}
1758 In-Reply-To: $header{'message-id'}
1759 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1761 X-$gProject-PR-Message: getinfo
1763 $description follows: