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);
14 use Debbugs::Config qw(:globals);
15 $lib_path = $gLibPath;
16 require "$lib_path/errorlib";
17 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
19 chdir("$gSpoolDir") || die "chdir spool: $!\n";
22 open DEBUG, ">/dev/null";
27 m/^[RC]\.\d+$/ || &quit("bad argument");
30 if (!rename("incoming/G$nn","incoming/P$nn")) {
31 $_=$!.''; m/no such file or directory/i && exit 0;
32 &quit("renaming to lock: $!");
35 open(M,"incoming/P$nn");
42 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
44 my $parser = new MIME::Parser;
45 mkdir "$gSpoolDir/mime.tmp", 0777;
46 $parser->output_under("$gSpoolDir/mime.tmp");
47 my $entity = eval { $parser->parse_data(join('',@log)) };
49 # header and decoded body respectively
50 my (@headerlines, @bodylines);
51 # Bug numbers to send e-mail to, hash so that we don't send to the
55 if ($entity and $entity->head->tags) {
56 @headerlines = @{$entity->head->header};
59 my $entity_body = getmailbody($entity);
60 @bodylines = $entity_body ? $entity_body->as_lines() : ();
63 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
65 for ($i = 0; $i <= $#msg; $i++) {
67 last unless length($_);
68 while ($msg[$i+1] =~ m/^\s/) {
72 push @headerlines, $_;
75 @bodylines = @msg[$i..$#msg];
79 $_ = decode_rfc1522($_);
81 print ">$_<\n" if $debug;
84 print ">$v=$_<\n" if $debug;
87 print "!>$_<\n" if $debug;
91 # Strip off RFC2440-style PGP clearsigning.
92 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
93 shift @bodylines while @bodylines and length $bodylines[0];
94 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
95 for my $findsig (0 .. $#bodylines) {
96 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
97 $#bodylines = $findsig - 1;
101 map { s/^- // } @bodylines;
104 grep(s/\s+$//,@bodylines);
106 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
108 if (defined $header{'resent-from'} && !defined $header{'from'}) {
109 $header{'from'} = $header{'resent-from'};
112 defined($header{'from'}) || &quit("no From header");
114 delete $header{'reply-to'}
115 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
117 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
118 $replyto = $header{'reply-to'};
120 $replyto = $header{'from'};
123 # This is an error counter which should be incremented every time there is an error.
125 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
127 &transcript("Processing commands for $controlrequestaddr:\n\n");
132 $mergelowstate= 'idle';
138 $user =~ s/^.*<(.*)>.*$/$1/;
139 $user =~ s/[(].*[)]//;
140 $user =~ s/^\s*(\S+)\s+.*$/$1/;
141 $user = "" unless (Debbugs::User::is_valid_user($user));
145 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
146 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
147 &transcript("This service is unavailable.\n\n");
156 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
159 for ($procline=0; $procline<=$#bodylines; $procline++) {
160 $state eq 'idle' || print "$state ?\n";
161 $lowstate eq 'idle' || print "$lowstate ?\n";
162 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
164 &transcript("Stopping processing here.\n\n");
167 $_= $bodylines[$procline]; s/\s+$//;
169 &transcript("> $_\n");
172 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
173 &transcript("Stopping processing here.\n\n");
175 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
177 &transcript("Debug level $dl.\n\n");
178 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
180 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
181 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
183 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
184 "detailed logs for $gBug#$ref");
185 } elsif (m/^index(\s+full)?$/i) {
186 &transcript("This BTS function is currently disabled, sorry.\n\n");
188 $ok++; # well, it's not really ok, but it fixes #81224 :)
189 } elsif (m/^index-summary\s+by-package$/i) {
190 &transcript("This BTS function is currently disabled, sorry.\n\n");
192 $ok++; # well, it's not really ok, but it fixes #81224 :)
193 } elsif (m/^index-summary(\s+by-number)?$/i) {
194 &transcript("This BTS function is currently disabled, sorry.\n\n");
196 $ok++; # well, it's not really ok, but it fixes #81224 :)
197 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
198 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
199 } elsif (m/^index(\s+|-)maints?$/i) {
200 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
201 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
203 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
204 "$gBug list for maintainer \`$maint'");
206 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
208 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
209 "$gBug list for package $package");
211 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
212 &transcript("This BTS function is currently disabled, sorry.\n\n");
214 $ok++; # well, it's not really ok, but it fixes #81224 :)
215 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
216 &transcript("This BTS function is currently disabled, sorry.\n\n");
218 $ok++; # well, it's not really ok, but it fixes #81224 :)
219 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
220 &transcript("This BTS function is currently disabled, sorry.\n\n");
222 $ok++; # well, it's not really ok, but it fixes #81224 :)
223 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
224 # the following is basically a Debian-specific kludge, but who cares
226 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
227 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
228 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
230 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
231 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
232 &sendinfo("local", "$gConfigDir/$req", "$req file");
234 &transcript("Info file $req does not exist.\n\n");
236 } elsif (m/^help/i) {
240 } elsif (m/^refcard/i) {
241 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
242 } elsif (m/^subscribe/i) {
244 There is no $gProject $gBug mailing list. If you wish to review bug reports
245 please do so via http://$gWebDomain/ or ask this mail server
247 soon: MAILINGLISTS_TEXT
249 } elsif (m/^unsubscribe/i) {
251 soon: UNSUBSCRIBE_TEXT
252 soon: MAILINGLISTS_TEXT
254 } elsif (m/^user\s+(\S+)\s*$/i) {
256 if (Debbugs::User::is_valid_user($newuser)) {
257 my $olduser = ($user ne "" ? " (was $user)" : "");
258 &transcript("Setting user to $newuser$olduser.\n");
261 &transcript("Selected user id ($newuser) invalid, sorry\n");
265 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
268 my $hidden = ($2 ne "");
274 while (++$procline <= $#bodylines) {
275 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
279 &transcript("> $bodylines[$procline]\n");
281 my ($o, $txt) = ($1, $2);
282 if ($#cats == -1 && $o eq "+") {
283 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
289 unless (ref($cats[-1]) eq "HASH") {
290 $cats[-1] = { "nam" => $cats[-1],
291 "pri" => [], "ttl" => [] };
294 my ($desc, $ord, $op);
295 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
296 $desc = $1; $ord = $3; $op = "";
297 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
298 $desc = $1; $ord = $3; $op = $4;
299 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
300 $desc = ""; $op = $1;
302 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
307 $ord = 999 unless defined $ord;
310 push @{$cats[-1]->{"pri"}}, $prefix . $op;
311 push @{$cats[-1]->{"ttl"}}, $desc;
312 push @ords, "$ord $catsec";
314 @cats[-1]->{"def"} = $desc;
315 push @ords, "$ord DEF";
318 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
319 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
320 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
321 } elsif ($o eq "*") {
324 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
325 $name = $1; $prefix = $3;
327 $name = $txt; $prefix = "";
332 # XXX: got @cats, now do something with it
333 my $u = Debbugs::User::get_user($user);
335 &transcript("Added usercategory $catname.\n\n");
336 $u->{"categories"}->{$catname} = [ @cats ];
338 &transcript("Removed usercategory $catname.\n\n");
339 delete $u->{"categories"}->{$catname};
342 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
344 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
346 &transcript("No valid user selected\n");
351 Debbugs::User::read_usertags(\%ut, $user);
352 my @oldtags = (); my @newtags = (); my @badtags = ();
354 for my $t (split /[,\s]+/, $tags) {
355 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
362 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
365 for my $t (keys %chtags) {
366 $ut{$t} = [] unless defined $ut{$t};
368 for my $t (keys %ut) {
369 my %res = map { ($_, 1) } @{$ut{$t}};
370 push @oldtags, $t if defined $res{$ref};
371 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
372 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
373 : $addsubcode eq "=");
374 $res{$ref} = 1 if ($addop && defined $chtags{$t});
375 delete $res{$ref} if ($del);
376 push @newtags, $t if defined $res{$ref};
377 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
380 &transcript("There were no usertags set.\n");
382 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
384 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
385 Debbugs::User::write_usertags(\%ut, $user);
387 } elsif (!$control) {
389 Unknown command or malformed arguments to command.
390 (Use control\@$gEmailDomain to manipulate reports.)
394 if (++$unknowns >= 3) {
395 &transcript("Too many unknown commands, stopping here.\n\n");
398 #### "developer only" ones start here
399 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
402 $bug_affected{$ref}=1;
405 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
406 if (length($data->{done}) and not defined($version)) {
407 &transcript("$gBug is already closed, cannot re-close.\n\n");
412 "marked as fixed in version $version" :
414 ", send any further explanations to $data->{originator}";
416 &addmaintainers($data);
417 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
418 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
419 $data->{done}= $replyto;
420 my @keywords= split ' ', $data->{keywords};
421 if (grep $_ eq 'pending', @keywords) {
422 $extramessage= "Removed pending tag.\n";
423 $data->{keywords}= join ' ', grep $_ ne 'pending',
426 addfixedversions($data, $data->{package}, $version, 'binary');
429 From: $gMaintainerEmail ($gProject $gBug Tracking System)
430 To: $data->{originator}
431 Subject: $gBug#$ref acknowledged by developer
433 References: $header{'message-id'} $data->{msgid}
434 In-Reply-To: $data->{msgid}
435 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
436 Reply-To: $ref\@$gEmailDomain
437 X-$gProject-PR-Message: they-closed-control $ref
439 This is an automatic notification regarding your $gBug report
440 #$ref: $data->{subject},
441 which was filed against the $data->{package} package.
443 It has been marked as closed by one of the developers, namely
446 You should be hearing from them with a substantive response shortly,
447 in case you haven't already. If not, please contact them directly.
450 (administrator, $gProject $gBugs database)
453 &sendmailmessage($message,$data->{originator});
454 } while (&getnextbug);
457 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
459 $ref= $1; $newpackage= $2;
460 $bug_affected{$ref}=1;
462 $newpackage =~ y/A-Z/a-z/;
464 if (length($data->{package})) {
465 $action= "$gBug reassigned from package \`$data->{package}'".
466 " to \`$newpackage'.";
468 $action= "$gBug assigned to package \`$newpackage'.";
471 &addmaintainers($data);
472 $data->{package}= $newpackage;
473 $data->{found_versions}= [];
474 $data->{fixed_versions}= [];
475 # TODO: what if $newpackage is a source package?
476 addfoundversions($data, $data->{package}, $version, 'binary');
477 &addmaintainers($data);
478 } while (&getnextbug);
480 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
481 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
482 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
483 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
486 $bug_affected{$ref}=1;
488 if (@{$data->{fixed_versions}}) {
489 &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");
491 if (!length($data->{done})) {
492 &transcript("$gBug is already open, cannot reopen.\n\n");
496 $noriginator eq '' ? "$gBug reopened, originator not changed." :
497 "$gBug reopened, originator set to $noriginator.";
499 &addmaintainers($data);
500 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
501 $data->{fixed_versions}= [];
503 } while (&getnextbug);
506 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
511 if (!length($data->{done}) and not defined($version)) {
512 &transcript("$gBug is already open, cannot reopen.\n\n");
518 "$gBug marked as found in version $version." :
521 &addmaintainers($data);
522 # The 'done' field gets a bit weird with version
523 # tracking, because a bug may be closed by multiple
524 # people in different branches. Until we have something
525 # more flexible, we set it every time a bug is fixed,
526 # and clear it precisely when a found command is
527 # received for the rightmost fixed-in version, which
528 # equates to the most recent fixing of the bug, or when
529 # a versionless found command is received.
530 if (defined $version) {
531 my $lastfixed = $data->{fixed_versions}[-1];
532 # TODO: what if $data->{package} is a source package?
533 addfoundversions($data, $data->{package}, $version, 'binary');
534 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
538 # Versionless found; assume old-style "not fixed at
540 $data->{fixed_versions} = [];
543 } while (&getnextbug);
546 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
551 $action= "$gBug marked as not found in version $version.";
552 if (length($data->{done})) {
553 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
556 &addmaintainers($data);
557 removefoundversions($data, $data->{package}, $version, 'binary');
558 } while (&getnextbug);
560 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
561 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
564 $bug_affected{$ref}=1;
565 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
566 $ref = $clonebugs{$ref};
569 if (&checkpkglimit) {
571 &addmaintainers($data);
572 $oldsubmitter= $data->{originator};
573 $data->{originator}= $newsubmitter;
574 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
576 &transcript("$action\n");
577 if (length($data->{done})) {
578 &transcript("(By the way, that $gBug is currently marked as done.)\n");
582 From: $gMaintainerEmail ($gProject $gBug Tracking System)
584 Subject: $gBug#$ref submitter address changed
586 References: $header{'message-id'} $data->{msgid}
587 In-Reply-To: $data->{msgid}
588 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
589 Reply-To: $ref\@$gEmailDomain
590 X-$gProject-PR-Message: submitter-changed $ref
592 The submitter address recorded for your $gBug report
593 #$ref: $data->{subject}
596 The old submitter address for this report was
598 The new submitter address is
601 This change was made by
603 If it was incorrect, please contact them directly.
606 (administrator, $gProject $gBugs database)
609 &sendmailmessage($message,$oldsubmitter);
616 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
618 $ref= $1; $whereto= $2;
619 $bug_affected{$ref}=1;
621 if (length($data->{forwarded})) {
622 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
624 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
626 if (length($data->{done})) {
627 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
630 &addmaintainers($data);
631 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
632 &addccaddress("$gForwardList\@$gListDomain");
634 $data->{forwarded}= $whereto;
635 } while (&getnextbug);
637 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
640 $bug_affected{$ref}=1;
642 if (!length($data->{forwarded})) {
643 &transcript("$gBug is not marked as having been forwarded.\n\n");
646 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
648 &addmaintainers($data);
649 $data->{forwarded}= '';
650 } while (&getnextbug);
653 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
654 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
657 $bug_affected{$ref}=1;
659 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
660 &transcript("Severity level \`$newseverity' is not known.\n".
661 "Recognized are: $gShowSeverities.\n\n");
663 } elsif (exists $gObsoleteSeverities{$newseverity}) {
664 &transcript("Severity level \`$newseverity' is obsolete. " .
665 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
668 $printseverity= $data->{severity};
669 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
670 $action= "Severity set to \`$newseverity' from \`$printseverity'";
672 &addmaintainers($data);
673 if (defined $gStrongList and isstrongseverity($newseverity)) {
674 addbcc("$gStrongList\@$gListDomain");
676 $data->{severity}= $newseverity;
677 } while (&getnextbug);
679 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
681 $ref = $1; $addsubcode = $3; $tags = $4;
682 $bug_affected{$ref}=1;
684 if (defined $addsubcode) {
685 $addsub = "sub" if ($addsubcode eq "-");
686 $addsub = "add" if ($addsubcode eq "+");
687 $addsub = "set" if ($addsubcode eq "=");
691 foreach my $t (split /[\s,]+/, $tags) {
692 if (!grep($_ eq $t, @gTags)) {
699 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
700 "Recognized are: ".join(' ', @gTags).".\n\n");
704 if ($data->{keywords} eq '') {
705 &transcript("There were no tags set.\n");
707 &transcript("Tags were: $data->{keywords}\n");
709 if ($addsub eq "set") {
710 $action= "Tags set to: " . join(", ", @okaytags);
711 } elsif ($addsub eq "add") {
712 $action= "Tags added: " . join(", ", @okaytags);
713 } elsif ($addsub eq "sub") {
714 $action= "Tags removed: " . join(", ", @okaytags);
717 &addmaintainers($data);
718 $data->{keywords} = '' if ($addsub eq "set");
719 # Allow removing obsolete tags.
720 if ($addsub eq "sub") {
721 foreach my $t (@badtags) {
722 $data->{keywords} = join ' ', grep $_ ne $t,
723 split ' ', $data->{keywords};
726 # Now process all other additions and subtractions.
727 foreach my $t (@okaytags) {
728 $data->{keywords} = join ' ', grep $_ ne $t,
729 split ' ', $data->{keywords};
730 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
732 $data->{keywords} =~ s/\s*$//;
733 } while (&getnextbug);
735 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
737 my $bugnum = $2; my $blockers = $4;
739 $addsub = "sub" if ($1 eq "un");
740 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
741 $bugnum = $clonebugs{$bugnum};
746 foreach my $b (split /[\s,]+/, $blockers) {
750 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
751 $ref = $clonebugs{$ref};
755 push @okayblockers, $ref;
757 # add to the list all bugs that are merged with $b,
758 # because all of their data must be kept in sync
759 @thisbugmergelist= split(/ /,$data->{mergedwith});
762 foreach $ref (@thisbugmergelist) {
764 push @okayblockers, $ref;
771 push @badblockers, $ref;
775 push @badblockers, $b;
779 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
785 if ($data->{blockedby} eq '') {
786 &transcript("Was not blocked by any bugs.\n");
788 &transcript("Was blocked by: $data->{blockedby}\n");
790 if ($addsub eq "set") {
791 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
792 } elsif ($addsub eq "add") {
793 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
794 } elsif ($addsub eq "sub") {
795 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
800 &addmaintainers($data);
801 my @oldblockerlist = split ' ', $data->{blockedby};
802 $data->{blockedby} = '' if ($addsub eq "set");
803 foreach my $b (@okayblockers) {
804 $data->{blockedby} = manipset($data->{blockedby}, $b,
808 foreach my $b (@oldblockerlist) {
809 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
810 push @{$removedblocks{$b}}, $ref;
813 foreach my $b (split ' ', $data->{blockedby}) {
814 if (! grep { $_ eq $b } @oldblockerlist) {
815 push @{$addedblocks{$b}}, $ref;
818 } while (&getnextbug);
820 # Now that the blockedby data is updated, change blocks data
821 # to match the changes.
822 foreach $ref (keys %addedblocks) {
824 foreach my $b (@{$addedblocks{$ref}}) {
825 $data->{blocks} = manipset($data->{blocks}, $b, 1);
830 foreach $ref (keys %removedblocks) {
832 foreach my $b (@{$removedblocks{$ref}}) {
833 $data->{blocks} = manipset($data->{blocks}, $b, 0);
839 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
841 $ref= $1; $newtitle= $2;
842 $bug_affected{$ref}=1;
843 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
844 $ref = $clonebugs{$ref};
847 if (&checkpkglimit) {
849 &addmaintainers($data);
850 $data->{subject}= $newtitle;
851 $action= "Changed $gBug title.";
853 &transcript("$action\n");
854 if (length($data->{done})) {
855 &transcript("(By the way, that $gBug is currently marked as done.)\n");
864 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
867 $bug_affected{$ref} = 1;
869 if (!length($data->{mergedwith})) {
870 &transcript("$gBug is not marked as being merged with any others.\n\n");
873 $mergelowstate eq 'locked' || die "$mergelowstate ?";
874 $action= "Disconnected #$ref from all other report(s).";
875 @newmergelist= split(/ /,$data->{mergedwith});
877 @bug_affected{@newmergelist} = 1 x @newmergelist;
879 &addmaintainers($data);
880 $data->{mergedwith}= ($ref == $discref) ? ''
881 : join(' ',grep($_ ne $ref,@newmergelist));
882 } while (&getnextbug);
885 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
887 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
888 my @newmergelist= ();
893 while (defined($ref= shift(@tomerge))) {
894 &transcript("D| checking merge $ref\n") if $dl;
896 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
897 $ref = $clonebugs{$ref};
899 next if grep($_ == $ref,@newmergelist);
900 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
901 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
903 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
905 &checkmatch('package','m_package',$data->{package},@newmergelist);
906 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
907 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
908 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
909 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
910 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
911 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
912 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
913 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
914 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
915 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
916 if (length($mismatch)) {
917 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
920 &cancelbug; @newmergelist=(); last;
922 push(@newmergelist,$ref);
923 push(@tomerge,split(/ /,$data->{mergedwith}));
927 @newmergelist= sort { $a <=> $b } @newmergelist;
928 $action= "Merged @newmergelist.";
929 delete @fixed{keys %found};
930 for $ref (@newmergelist) {
931 &getbug || die "huh ? $gBug $ref disappeared during merge";
932 &addmaintainers($data);
933 @bug_affected{@newmergelist} = 1 x @newmergelist;
934 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
935 $data->{keywords}= join(' ', keys %tags);
936 $data->{found_versions}= [sort keys %found];
937 $data->{fixed_versions}= [sort keys %fixed];
940 &transcript("$action\n\n");
943 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
945 my @temp = split /\s+\#?/,$1;
946 my $master_bug = shift @temp;
948 my @tomerge = sort { $a <=> $b } @temp;
949 unshift @tomerge,$master_bug;
950 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
951 my @newmergelist= ();
955 # Here we try to do the right thing.
956 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
957 # If not, we discard the found and fixed.
958 # Everything else we set to the values of the first bug.
960 while (defined($ref= shift(@tomerge))) {
961 &transcript("D| checking merge $ref\n") if $dl;
963 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
964 $ref = $clonebugs{$ref};
966 next if grep($_ == $ref,@newmergelist);
967 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
968 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
970 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
971 $master_bug_data = $data if not defined $master_bug_data;
972 if ($data->{package} ne $master_bug_data->{package}) {
973 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
974 "$gBug $ref is not in the same package as $master_bug\n");
976 &cancelbug; @newmergelist=(); last;
978 for my $t (split /\s+/,$data->{keywords}) {
981 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
982 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
983 push(@newmergelist,$ref);
984 push(@tomerge,split(/ /,$data->{mergedwith}));
988 @newmergelist= sort { $a <=> $b } @newmergelist;
989 $action= "Forcibly Merged @newmergelist.";
990 delete @fixed{keys %found};
991 for $ref (@newmergelist) {
992 &getbug || die "huh ? $gBug $ref disappeared during merge";
993 &addmaintainers($data);
994 @bug_affected{@newmergelist} = 1 x @newmergelist;
995 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
996 $data->{keywords}= join(' ', keys %tags);
997 $data->{found_versions}= [sort keys %found];
998 $data->{fixed_versions}= [sort keys %fixed];
999 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1000 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1003 &transcript("$action\n\n");
1006 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1010 @newclonedids = split /\s+/, $2;
1011 $newbugsneeded = scalar(@newclonedids);
1014 $bug_affected{$ref} = 1;
1016 if (length($data->{mergedwith})) {
1017 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1021 &filelock("nextnumber.lock");
1022 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1023 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1024 $firstref= $v+0; $v += $newbugsneeded;
1025 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1028 $lastref = $firstref + $newbugsneeded - 1;
1030 if ($newbugsneeded == 1) {
1031 $action= "$gBug $origref cloned as bug $firstref.";
1033 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1036 my $blocks = $data->{blocks};
1037 my $blockedby = $data->{blockedby};
1040 my $ohash = get_hashname($origref);
1041 my $clone = $firstref;
1042 @bug_affected{@newclonedids} = 1 x @newclonedids;
1043 for $newclonedid (@newclonedids) {
1044 $clonebugs{$newclonedid} = $clone;
1046 my $hash = get_hashname($clone);
1047 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1048 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1049 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1050 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1051 &bughook('new', $clone, $data);
1053 # Update blocking info of bugs blocked by or blocking the
1055 foreach $ref (split ' ', $blocks) {
1057 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1060 foreach $ref (split ' ', $blockedby) {
1062 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1070 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
1072 my @pkgs = split /\s+/, $1;
1073 if (scalar(@pkgs) > 0) {
1074 %limit_pkgs = map { ($_, 1) } @pkgs;
1075 &transcript("Ignoring bugs not assigned to: " .
1076 join(" ", keys(%limit_pkgs)) . "\n\n");
1079 &transcript("Not ignoring any bugs.\n\n");
1081 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1082 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1085 $bug_affected{$ref} = 1;
1087 if (length $data->{owner}) {
1088 $action = "Owner changed from $data->{owner} to $newowner.";
1090 $action = "Owner recorded as $newowner.";
1092 if (length $data->{done}) {
1093 $extramessage = "(By the way, this $gBug is currently " .
1094 "marked as done.)\n";
1097 &addmaintainers($data);
1098 $data->{owner} = $newowner;
1099 } while (&getnextbug);
1101 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1104 $bug_affected{$ref} = 1;
1106 if (length $data->{owner}) {
1107 $action = "Removed annotation that $gBug was owned by " .
1110 &addmaintainers($data);
1111 $data->{owner} = '';
1112 } while (&getnextbug);
1114 &transcript("$gBug is not marked as having an owner.\n\n");
1119 &transcript("Unknown command or malformed arguments to command.\n\n");
1121 if (++$unknowns >= 5) {
1122 &transcript("Too many unknown commands, stopping here.\n\n");
1127 if ($procline>$#bodylines) {
1128 &transcript(">\nEnd of message, stopping processing here.\n\n");
1130 if (!$ok && !quickabort) {
1132 &transcript("No commands successfully parsed; sending the help text(s).\n");
1137 &transcript("MC\n") if $dl>1;
1139 for $maint (keys %maintccreasons) {
1140 &transcript("MM|$maint|\n") if $dl>1;
1141 next if $maint eq $replyto;
1143 $reasonsref= $maintccreasons{$maint};
1144 &transcript("MY|$maint|\n") if $dl>2;
1145 for $p (sort keys %$reasonsref) {
1146 &transcript("MP|$p|\n") if $dl>2;
1147 $reasonstring.= ', ' if length($reasonstring);
1148 $reasonstring.= $p.' ' if length($p);
1149 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1151 if (length($reasonstring) > 40) {
1152 (substr $reasonstring, 37) = "...";
1154 $reasonstring = "" if (!defined($reasonstring));
1155 push(@maintccs,"$maint ($reasonstring)");
1156 push(@maintccaddrs,"$maint");
1161 &transcript("MC|@maintccs|\n") if $dl>2;
1162 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1165 # Add Bcc's to subscribed bugs
1166 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1168 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1169 $header{'subject'} = "your mail";
1172 # Error text here advertises how many errors there were
1173 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1176 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1178 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1179 In-Reply-To: $header{'message-id'}
1180 References: $header{'message-id'}
1181 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1183 X-$gProject-PR-Message: transcript
1185 ${transcript}Please contact me if you need assistance.
1188 (administrator, $gProject $gBugs database)
1192 $repliedshow= join(', ',$replyto,@maintccaddrs);
1193 &filelock("lock/-1");
1194 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1196 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1198 "<strong>Request received</strong> from <code>".
1199 encode_entities($header{'from'})."</code>\n".
1200 "to <code>".encode_entities($controlrequestaddr)."</code>\n".
1202 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1203 close(AP) || &quit("open db-h/-1.log: $!");
1205 utime(time,time,"db-h");
1207 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1209 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1211 sub sendmailmessage {
1212 local ($message,@recips) = @_;
1213 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1214 send_mail_message(message => $message,
1215 recipients => \@recips,
1221 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1222 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1226 #sub unimplemented {
1227 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1231 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1233 if (@newmergelist) {
1234 eval "\$mvarvalue= \$$mvarname";
1235 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1238 "Values for \`$string' don't match:\n".
1239 " #$newmergelist[0] has \`$mvarvalue';\n".
1240 " #$ref has \`$svarvalue'\n"
1241 if $mvarvalue ne $svarvalue;
1243 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1245 eval "\$$mvarname= \$svarvalue";
1250 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1251 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1263 my %h = map { $_ => 1 } split ' ', $list;
1270 return join ' ', sort keys %h;
1273 # High-level bug manipulation calls
1274 # Do announcements themselves
1276 # Possible calling sequences:
1277 # setbug (returns 0)
1279 # setbug (returns 1)
1280 # &transcript(something)
1283 # setbug (returns 1)
1284 # $action= (something)
1286 # (modify s_* variables)
1287 # } while (getnextbug);
1290 &dlen("nochangebug");
1291 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1293 &endmerge if $manybugs;
1295 &dlex("nochangebug");
1299 &dlen("setbug $ref");
1300 if ($ref =~ m/^-\d+/) {
1301 if (!defined $clonebugs{$ref}) {
1303 &dlex("setbug => noclone");
1306 $ref = $clonebugs{$ref};
1308 $state eq 'idle' || die "$state ?";
1311 &dlex("setbug => 0s");
1315 if (!&checkpkglimit) {
1320 @thisbugmergelist= split(/ /,$data->{mergedwith});
1321 if (!@thisbugmergelist) {
1326 &dlex("setbug => 1s");
1335 &dlex("setbug => 0mc");
1339 $state= 'multiple'; $sref=$ref;
1340 &dlex("setbug => 1m");
1345 &dlen("getnextbug");
1346 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1348 if (!$manybugs || !@thisbugmergelist) {
1349 length($action) || die;
1350 &transcript("$action\n$extramessage\n");
1351 &endmerge if $manybugs;
1353 &dlex("getnextbug => 0");
1356 $ref= shift(@thisbugmergelist);
1357 &getbug || die "bug $ref disappeared";
1359 &dlex("getnextbug => 1");
1363 # Low-level bug-manipulation calls
1364 # Do no announcements
1366 # getbug (returns 0)
1368 # getbug (returns 1)
1372 # $action= (something)
1373 # getbug (returns 1)
1375 # getbug (returns 1)
1377 # [getbug (returns 0)]
1378 # &transcript("$action\n\n")
1381 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1382 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1386 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1387 &filelock('lock/merge');
1388 $mergelowstate='locked';
1394 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1396 $mergelowstate='idle';
1401 &dlen("getbug $ref");
1402 $lowstate eq 'idle' || die "$state ?";
1403 if (($data = &lockreadbug($ref))) {
1406 &dlex("getbug => 1");
1411 &dlex("getbug => 0");
1417 $lowstate eq 'open' || die "$state ?";
1424 &dlen("savebug $ref");
1425 $lowstate eq 'open' || die "$lowstate ?";
1426 length($action) || die;
1427 $ref == $sref || die "read $sref but saving $ref ?";
1428 my $hash = get_hashname($ref);
1429 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1432 "<strong>".encode_entities($action)."</strong>\n".
1433 "Request was from <code>".encode_entities($header{'from'})."</code>\n".
1434 "to <code>".encode_entities($controlrequestaddr)."</code>. \n".
1436 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1437 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1438 unlockwritebug($ref, $data);
1445 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1450 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1454 print $_[0] if $debug;
1455 $transcript.= $_[0];
1462 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1463 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1479 sub sendtxthelpraw {
1480 local ($relpath,$description) = @_;
1482 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1483 while(<D>) { $doc.=$_; }
1485 &transcript("Sending $description in separate message.\n");
1486 &sendmailmessage(<<END.$doc,$replyto);
1487 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1489 Subject: $gProject $gBug help: $description
1490 References: $header{'message-id'}
1491 In-Reply-To: $header{'message-id'}
1492 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1494 X-$gProject-PR-Message: doc-text $relpath
1500 sub sendlynxdocraw {
1501 local ($relpath,$description) = @_;
1503 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1504 while(<L>) { $doc.=$_; }
1506 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1507 &transcript("Information ($description) is not available -\n".
1508 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1511 &transcript("Error getting $description (code $? $!):\n$doc\n");
1513 &transcript("Sending $description.\n");
1514 &sendmailmessage(<<END.$doc,$replyto);
1515 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1517 Subject: $gProject $gBugs information: $description
1518 References: $header{'message-id'}
1519 In-Reply-To: $header{'message-id'}
1520 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1522 X-$gProject-PR-Message: doc-html $relpath
1531 $maintccreasons{$cca}{''}{$ref}= 1;
1534 sub addmaintainers {
1535 # Data structure is:
1536 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1539 &ensuremaintainersloaded;
1540 $anymaintfound=0; $anymaintnotfound=0;
1541 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1543 $p =~ /([a-z0-9.+-]+)/;
1545 next unless defined $p;
1546 if (defined $gSubscriptionDomain) {
1547 if (defined($pkgsrc{$p})) {
1548 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1550 addbcc("$p\@$gSubscriptionDomain");
1553 if (defined $data->{severity} and defined $gStrongList and
1554 isstrongseverity($data->{severity})) {
1555 addbcc("$gStrongList\@$gListDomain");
1557 if (defined($maintainerof{$p})) {
1558 $addmaint= $maintainerof{$p};
1559 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1560 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1561 print "maintainer add >$p|$addmaint<\n" if $debug;
1563 print "maintainer none >$p<\n" if $debug;
1564 &transcript("Warning: Unknown package '$p'\n");
1565 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1566 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1570 if (length $data->{owner}) {
1571 $addmaint = $data->{owner};
1572 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1573 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1574 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1578 sub ensuremaintainersloaded {
1580 return if $maintainersloaded++;
1581 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1585 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1586 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1587 $maintainerof{$a}= $2;
1590 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1594 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1595 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1596 $maintainerof{$a}= $2;
1599 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1601 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1602 my ($a, $b) = ($1, $2);
1603 $pkgsrc{lc($a)} = $b;
1609 local ($wherefrom,$path,$description) = @_;
1610 if ($wherefrom eq "ftp.d.o") {
1611 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1613 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1614 &transcript("$description is not available.\n");
1617 &transcript("Error getting $description (code $? $!):\n$doc\n");
1620 } elsif ($wherefrom eq "local") {
1622 $doc = do { local $/; <P> };
1625 &transcript("internal errror: info files location unknown.\n");
1628 &transcript("Sending $description.\n");
1629 &sendmailmessage(<<END.$doc,$replyto);
1630 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1632 Subject: $gProject $gBugs information: $description
1633 References: $header{'message-id'}
1634 In-Reply-To: $header{'message-id'}
1635 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1637 X-$gProject-PR-Message: getinfo
1639 $description follows: