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);
13 use Debbugs::Config qw(:globals);
14 $lib_path = $gLibPath;
15 require "$lib_path/errorlib";
16 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
18 chdir("$gSpoolDir") || die "chdir spool: $!\n";
21 open DEBUG, ">/dev/null";
26 m/^[RC]\.\d+$/ || &quit("bad argument");
29 if (!rename("incoming/G$nn","incoming/P$nn")) {
30 $_=$!.''; m/no such file or directory/i && exit 0;
31 &quit("renaming to lock: $!");
34 open(M,"incoming/P$nn");
41 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
43 my $parser = new MIME::Parser;
44 mkdir "$gSpoolDir/mime.tmp", 0777;
45 $parser->output_under("$gSpoolDir/mime.tmp");
46 my $entity = eval { $parser->parse_data(join('',@log)) };
48 # header and decoded body respectively
49 my (@headerlines, @bodylines);
50 # Bug numbers to send e-mail to, hash so that we don't send to the
54 if ($entity and $entity->head->tags) {
55 @headerlines = @{$entity->head->header};
58 my $entity_body = getmailbody($entity);
59 @bodylines = $entity_body ? $entity_body->as_lines() : ();
62 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
64 for ($i = 0; $i <= $#msg; $i++) {
66 last unless length($_);
67 while ($msg[$i+1] =~ m/^\s/) {
71 push @headerlines, $_;
74 @bodylines = @msg[$i..$#msg];
78 $_ = decode_rfc1522($_);
80 print ">$_<\n" if $debug;
83 print ">$v=$_<\n" if $debug;
86 print "!>$_<\n" if $debug;
90 # Strip off RFC2440-style PGP clearsigning.
91 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
92 shift @bodylines while @bodylines and length $bodylines[0];
93 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
94 for my $findsig (0 .. $#bodylines) {
95 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
96 $#bodylines = $findsig - 1;
100 map { s/^- // } @bodylines;
103 grep(s/\s+$//,@bodylines);
105 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
107 if (defined $header{'resent-from'} && !defined $header{'from'}) {
108 $header{'from'} = $header{'resent-from'};
111 defined($header{'from'}) || &quit("no From header");
113 delete $header{'reply-to'}
114 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
116 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
117 $replyto = $header{'reply-to'};
119 $replyto = $header{'from'};
122 # This is an error counter which should be incremented every time there is an error.
124 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
126 &transcript("Processing commands for $controlrequestaddr:\n\n");
131 $mergelowstate= 'idle';
137 $user =~ s/^.*<(.*)>.*$/$1/;
138 $user =~ s/[(].*[)]//;
139 $user =~ s/^\s*(\S+)\s+.*$/$1/;
140 $user = "" unless (Debbugs::User::is_valid_user($user));
144 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
145 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
146 &transcript("This service is unavailable.\n\n");
155 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
158 for ($procline=0; $procline<=$#bodylines; $procline++) {
159 $state eq 'idle' || print "$state ?\n";
160 $lowstate eq 'idle' || print "$lowstate ?\n";
161 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
163 &transcript("Stopping processing here.\n\n");
166 $_= $bodylines[$procline]; s/\s+$//;
168 &transcript("> $_\n");
171 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
172 &transcript("Stopping processing here.\n\n");
174 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
176 &transcript("Debug level $dl.\n\n");
177 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
179 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
180 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
182 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
183 "detailed logs for $gBug#$ref");
184 } elsif (m/^index(\s+full)?$/i) {
185 &transcript("This BTS function is currently disabled, sorry.\n\n");
187 $ok++; # well, it's not really ok, but it fixes #81224 :)
188 } elsif (m/^index-summary\s+by-package$/i) {
189 &transcript("This BTS function is currently disabled, sorry.\n\n");
191 $ok++; # well, it's not really ok, but it fixes #81224 :)
192 } elsif (m/^index-summary(\s+by-number)?$/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(\s+|-)pack(age)?s?$/i) {
197 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
198 } elsif (m/^index(\s+|-)maints?$/i) {
199 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
200 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
202 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
203 "$gBug list for maintainer \`$maint'");
205 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
207 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
208 "$gBug list for package $package");
210 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
211 &transcript("This BTS function is currently disabled, sorry.\n\n");
213 $ok++; # well, it's not really ok, but it fixes #81224 :)
214 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
215 &transcript("This BTS function is currently disabled, sorry.\n\n");
217 $ok++; # well, it's not really ok, but it fixes #81224 :)
218 } elsif (m/^send-unmatched\s+(old|-2)$/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/^getinfo\s+([\w-.]+)$/i) {
223 # the following is basically a Debian-specific kludge, but who cares
225 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
226 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
227 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
229 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
230 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
231 &sendinfo("local", "$gConfigDir/$req", "$req file");
233 &transcript("Info file $req does not exist.\n\n");
235 } elsif (m/^help/i) {
239 } elsif (m/^refcard/i) {
240 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
241 } elsif (m/^subscribe/i) {
243 There is no $gProject $gBug mailing list. If you wish to review bug reports
244 please do so via http://$gWebDomain/ or ask this mail server
246 soon: MAILINGLISTS_TEXT
248 } elsif (m/^unsubscribe/i) {
250 soon: UNSUBSCRIBE_TEXT
251 soon: MAILINGLISTS_TEXT
253 } elsif (m/^user\s+(\S+)\s*$/i) {
255 if (Debbugs::User::is_valid_user($newuser)) {
256 my $olduser = ($user ne "" ? " (was $user)" : "");
257 &transcript("Setting user to $newuser$olduser.\n");
260 &transcript("Selected user id ($newuser) invalid, sorry\n");
264 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
267 my $hidden = ($2 ne "");
273 while (++$procline <= $#bodylines) {
274 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
278 &transcript("> $bodylines[$procline]\n");
280 my ($o, $txt) = ($1, $2);
281 if ($#cats == -1 && $o eq "+") {
282 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
288 unless (ref($cats[-1]) eq "HASH") {
289 $cats[-1] = { "nam" => $cats[-1],
290 "pri" => [], "ttl" => [] };
293 my ($desc, $ord, $op);
294 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
295 $desc = $1; $ord = $3; $op = "";
296 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
297 $desc = $1; $ord = $3; $op = $4;
298 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
299 $desc = ""; $op = $1;
301 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
306 $ord = 999 unless defined $ord;
309 push @{$cats[-1]->{"pri"}}, $prefix . $op;
310 push @{$cats[-1]->{"ttl"}}, $desc;
311 push @ords, "$ord $catsec";
313 @cats[-1]->{"def"} = $desc;
314 push @ords, "$ord DEF";
317 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
318 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
319 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
320 } elsif ($o eq "*") {
323 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
324 $name = $1; $prefix = $3;
326 $name = $txt; $prefix = "";
331 # XXX: got @cats, now do something with it
332 my $u = Debbugs::User::get_user($user);
334 &transcript("Added usercategory $catname.\n\n");
335 $u->{"categories"}->{$catname} = [ @cats ];
337 &transcript("Removed usercategory $catname.\n\n");
338 delete $u->{"categories"}->{$catname};
341 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
343 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
345 &transcript("No valid user selected\n");
350 Debbugs::User::read_usertags(\%ut, $user);
351 my @oldtags = (); my @newtags = (); my @badtags = ();
353 for my $t (split /[,\s]+/, $tags) {
354 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
361 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
364 for my $t (keys %chtags) {
365 $ut{$t} = [] unless defined $ut{$t};
367 for my $t (keys %ut) {
368 my %res = map { ($_, 1) } @{$ut{$t}};
369 push @oldtags, $t if defined $res{$ref};
370 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
371 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
372 : $addsubcode eq "=");
373 $res{$ref} = 1 if ($addop && defined $chtags{$t});
374 delete $res{$ref} if ($del);
375 push @newtags, $t if defined $res{$ref};
376 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
379 &transcript("There were no usertags set.\n");
381 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
383 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
384 Debbugs::User::write_usertags(\%ut, $user);
386 } elsif (!$control) {
388 Unknown command or malformed arguments to command.
389 (Use control\@$gEmailDomain to manipulate reports.)
393 if (++$unknowns >= 3) {
394 &transcript("Too many unknown commands, stopping here.\n\n");
397 #### "developer only" ones start here
398 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
401 $bug_affected{$ref}=1;
404 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
405 if (length($data->{done}) and not defined($version)) {
406 &transcript("$gBug is already closed, cannot re-close.\n\n");
411 "marked as fixed in version $version" :
413 ", send any further explanations to $data->{originator}";
415 &addmaintainers($data);
416 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
417 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
418 $data->{done}= $replyto;
419 my @keywords= split ' ', $data->{keywords};
420 if (grep $_ eq 'pending', @keywords) {
421 $extramessage= "Removed pending tag.\n";
422 $data->{keywords}= join ' ', grep $_ ne 'pending',
425 addfixedversions($data, $data->{package}, $version, 'binary');
428 From: $gMaintainerEmail ($gProject $gBug Tracking System)
429 To: $data->{originator}
430 Subject: $gBug#$ref acknowledged by developer
432 References: $header{'message-id'} $data->{msgid}
433 In-Reply-To: $data->{msgid}
434 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
435 Reply-To: $ref\@$gEmailDomain
436 X-$gProject-PR-Message: they-closed-control $ref
438 This is an automatic notification regarding your $gBug report
439 #$ref: $data->{subject},
440 which was filed against the $data->{package} package.
442 It has been marked as closed by one of the developers, namely
445 You should be hearing from them with a substantive response shortly,
446 in case you haven't already. If not, please contact them directly.
449 (administrator, $gProject $gBugs database)
452 &sendmailmessage($message,$data->{originator});
453 } while (&getnextbug);
456 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
458 $ref= $1; $newpackage= $2;
459 $bug_affected{$ref}=1;
461 $newpackage =~ y/A-Z/a-z/;
463 if (length($data->{package})) {
464 $action= "$gBug reassigned from package \`$data->{package}'".
465 " to \`$newpackage'.";
467 $action= "$gBug assigned to package \`$newpackage'.";
470 &addmaintainers($data);
471 $data->{package}= $newpackage;
472 $data->{found_versions}= [];
473 $data->{fixed_versions}= [];
474 # TODO: what if $newpackage is a source package?
475 addfoundversions($data, $data->{package}, $version, 'binary');
476 &addmaintainers($data);
477 } while (&getnextbug);
479 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
480 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
481 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
482 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
485 $bug_affected{$ref}=1;
487 if (@{$data->{fixed_versions}}) {
488 &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");
490 if (!length($data->{done})) {
491 &transcript("$gBug is already open, cannot reopen.\n\n");
495 $noriginator eq '' ? "$gBug reopened, originator not changed." :
496 "$gBug reopened, originator set to $noriginator.";
498 &addmaintainers($data);
499 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
500 $data->{fixed_versions}= [];
502 } while (&getnextbug);
505 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
510 if (!length($data->{done}) and not defined($version)) {
511 &transcript("$gBug is already open, cannot reopen.\n\n");
517 "$gBug marked as found in version $version." :
520 &addmaintainers($data);
521 # The 'done' field gets a bit weird with version
522 # tracking, because a bug may be closed by multiple
523 # people in different branches. Until we have something
524 # more flexible, we set it every time a bug is fixed,
525 # and clear it precisely when a found command is
526 # received for the rightmost fixed-in version, which
527 # equates to the most recent fixing of the bug, or when
528 # a versionless found command is received.
529 if (defined $version) {
530 my $lastfixed = $data->{fixed_versions}[-1];
531 # TODO: what if $data->{package} is a source package?
532 addfoundversions($data, $data->{package}, $version, 'binary');
533 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
537 # Versionless found; assume old-style "not fixed at
539 $data->{fixed_versions} = [];
542 } while (&getnextbug);
545 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
550 $action= "$gBug marked as not found in version $version.";
551 if (length($data->{done})) {
552 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
555 &addmaintainers($data);
556 removefoundversions($data, $data->{package}, $version, 'binary');
557 } while (&getnextbug);
559 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
560 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
563 $bug_affected{$ref}=1;
564 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
565 $ref = $clonebugs{$ref};
568 if (&checkpkglimit) {
570 &addmaintainers($data);
571 $oldsubmitter= $data->{originator};
572 $data->{originator}= $newsubmitter;
573 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
575 &transcript("$action\n");
576 if (length($data->{done})) {
577 &transcript("(By the way, that $gBug is currently marked as done.)\n");
581 From: $gMaintainerEmail ($gProject $gBug Tracking System)
583 Subject: $gBug#$ref submitter address changed
585 References: $header{'message-id'} $data->{msgid}
586 In-Reply-To: $data->{msgid}
587 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
588 Reply-To: $ref\@$gEmailDomain
589 X-$gProject-PR-Message: submitter-changed $ref
591 The submitter address recorded for your $gBug report
592 #$ref: $data->{subject}
595 The old submitter address for this report was
597 The new submitter address is
600 This change was made by
602 If it was incorrect, please contact them directly.
605 (administrator, $gProject $gBugs database)
608 &sendmailmessage($message,$oldsubmitter);
615 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
617 $ref= $1; $whereto= $2;
618 $bug_affected{$ref}=1;
620 if (length($data->{forwarded})) {
621 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
623 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
625 if (length($data->{done})) {
626 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
629 &addmaintainers($data);
630 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
631 &addccaddress("$gForwardList\@$gListDomain");
633 $data->{forwarded}= $whereto;
634 } while (&getnextbug);
636 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
639 $bug_affected{$ref}=1;
641 if (!length($data->{forwarded})) {
642 &transcript("$gBug is not marked as having been forwarded.\n\n");
645 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
647 &addmaintainers($data);
648 $data->{forwarded}= '';
649 } while (&getnextbug);
652 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
653 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
656 $bug_affected{$ref}=1;
658 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
659 &transcript("Severity level \`$newseverity' is not known.\n".
660 "Recognized are: $gShowSeverities.\n\n");
662 } elsif (exists $gObsoleteSeverities{$newseverity}) {
663 &transcript("Severity level \`$newseverity' is obsolete. " .
664 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
667 $printseverity= $data->{severity};
668 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
669 $action= "Severity set to \`$newseverity' from \`$printseverity'";
671 &addmaintainers($data);
672 if (defined $gStrongList and isstrongseverity($newseverity)) {
673 addbcc("$gStrongList\@$gListDomain");
675 $data->{severity}= $newseverity;
676 } while (&getnextbug);
678 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
680 $ref = $1; $addsubcode = $3; $tags = $4;
681 $bug_affected{$ref}=1;
683 if (defined $addsubcode) {
684 $addsub = "sub" if ($addsubcode eq "-");
685 $addsub = "add" if ($addsubcode eq "+");
686 $addsub = "set" if ($addsubcode eq "=");
690 foreach my $t (split /[\s,]+/, $tags) {
691 if (!grep($_ eq $t, @gTags)) {
698 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
699 "Recognized are: ".join(' ', @gTags).".\n\n");
703 if ($data->{keywords} eq '') {
704 &transcript("There were no tags set.\n");
706 &transcript("Tags were: $data->{keywords}\n");
708 if ($addsub eq "set") {
709 $action= "Tags set to: " . join(", ", @okaytags);
710 } elsif ($addsub eq "add") {
711 $action= "Tags added: " . join(", ", @okaytags);
712 } elsif ($addsub eq "sub") {
713 $action= "Tags removed: " . join(", ", @okaytags);
716 &addmaintainers($data);
717 $data->{keywords} = '' if ($addsub eq "set");
718 # Allow removing obsolete tags.
719 if ($addsub eq "sub") {
720 foreach my $t (@badtags) {
721 $data->{keywords} = join ' ', grep $_ ne $t,
722 split ' ', $data->{keywords};
725 # Now process all other additions and subtractions.
726 foreach my $t (@okaytags) {
727 $data->{keywords} = join ' ', grep $_ ne $t,
728 split ' ', $data->{keywords};
729 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
731 $data->{keywords} =~ s/\s*$//;
732 } while (&getnextbug);
734 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
736 my $bugnum = $2; my $blockers = $4;
738 $addsub = "sub" if ($1 eq "un");
739 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
740 $bugnum = $clonebugs{$bugnum};
745 foreach my $b (split /[\s,]+/, $blockers) {
749 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
750 $ref = $clonebugs{$ref};
753 push @okayblockers, $ref;
755 # add to the list all bugs that are merged with $b,
756 # because all of their data must be kept in sync
757 @thisbugmergelist= split(/ /,$data->{mergedwith});
760 foreach $ref (@thisbugmergelist) {
762 push @okayblockers, $ref;
769 push @badblockers, $ref;
773 push @badblockers, $b;
777 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
783 if ($data->{blockedby} eq '') {
784 &transcript("Was not blocked by any bugs.\n");
786 &transcript("Was blocked by: $data->{blockedby}\n");
788 if ($addsub eq "set") {
789 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
790 } elsif ($addsub eq "add") {
791 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
792 } elsif ($addsub eq "sub") {
793 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
798 &addmaintainers($data);
799 my @oldblockerlist = split ' ', $data->{blockedby};
800 $data->{blockedby} = '' if ($addsub eq "set");
801 foreach my $b (@okayblockers) {
802 $data->{blockedby} = manipset($data->{blockedby}, $b,
806 foreach my $b (@oldblockerlist) {
807 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
808 push @{$removedblocks{$b}}, $ref;
811 foreach my $b (split ' ', $data->{blockedby}) {
812 if (! grep { $_ eq $b } @oldblockerlist) {
813 push @{$addedblocks{$b}}, $ref;
816 } while (&getnextbug);
818 # Now that the blockedby data is updated, change blocks data
819 # to match the changes.
820 foreach $ref (keys %addedblocks) {
822 foreach my $b (@{$addedblocks{$ref}}) {
823 $data->{blocks} = manipset($data->{blocks}, $b, 1);
828 foreach $ref (keys %removedblocks) {
830 foreach my $b (@{$removedblocks{$ref}}) {
831 $data->{blocks} = manipset($data->{blocks}, $b, 0);
837 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
839 $ref= $1; $newtitle= $2;
840 $bug_affected{$ref}=1;
841 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
842 $ref = $clonebugs{$ref};
845 if (&checkpkglimit) {
847 &addmaintainers($data);
848 $data->{subject}= $newtitle;
849 $action= "Changed $gBug title.";
851 &transcript("$action\n");
852 if (length($data->{done})) {
853 &transcript("(By the way, that $gBug is currently marked as done.)\n");
862 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
865 $bug_affected{$ref} = 1;
867 if (!length($data->{mergedwith})) {
868 &transcript("$gBug is not marked as being merged with any others.\n\n");
871 $mergelowstate eq 'locked' || die "$mergelowstate ?";
872 $action= "Disconnected #$ref from all other report(s).";
873 @newmergelist= split(/ /,$data->{mergedwith});
875 @bug_affected{@newmergelist} = 1 x @newmergelist;
877 &addmaintainers($data);
878 $data->{mergedwith}= ($ref == $discref) ? ''
879 : join(' ',grep($_ ne $ref,@newmergelist));
880 } while (&getnextbug);
883 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
885 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
886 my @newmergelist= ();
891 while (defined($ref= shift(@tomerge))) {
892 &transcript("D| checking merge $ref\n") if $dl;
894 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
895 $ref = $clonebugs{$ref};
897 next if grep($_ == $ref,@newmergelist);
898 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
899 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
901 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
903 &checkmatch('package','m_package',$data->{package},@newmergelist);
904 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
905 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
906 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
907 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
908 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
909 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
910 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
911 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
912 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
913 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
914 if (length($mismatch)) {
915 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
918 &cancelbug; @newmergelist=(); last;
920 push(@newmergelist,$ref);
921 push(@tomerge,split(/ /,$data->{mergedwith}));
925 @newmergelist= sort { $a <=> $b } @newmergelist;
926 $action= "Merged @newmergelist.";
927 delete @fixed{keys %found};
928 for $ref (@newmergelist) {
929 &getbug || die "huh ? $gBug $ref disappeared during merge";
930 &addmaintainers($data);
931 @bug_affected{@newmergelist} = 1 x @newmergelist;
932 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
933 $data->{keywords}= join(' ', keys %tags);
934 $data->{found_versions}= [sort keys %found];
935 $data->{fixed_versions}= [sort keys %fixed];
938 &transcript("$action\n\n");
941 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
943 my @temp = split /\s+\#?/,$1;
944 my $master_bug = shift @temp;
946 my @tomerge = sort { $a <=> $b } @temp;
947 unshift @tomerge,$master_bug;
948 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
949 my @newmergelist= ();
953 # Here we try to do the right thing.
954 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
955 # If not, we discard the found and fixed.
956 # Everything else we set to the values of the first bug.
958 while (defined($ref= shift(@tomerge))) {
959 &transcript("D| checking merge $ref\n") if $dl;
961 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
962 $ref = $clonebugs{$ref};
964 next if grep($_ == $ref,@newmergelist);
965 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
966 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
968 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
969 $master_bug_data = $data if not defined $master_bug_data;
970 if ($data->{package} ne $master_bug_data->{package}) {
971 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
972 "$gBug $ref is not in the same package as $master_bug\n");
974 &cancelbug; @newmergelist=(); last;
976 for my $t (split /\s+/,$data->{keywords}) {
979 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
980 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
981 push(@newmergelist,$ref);
982 push(@tomerge,split(/ /,$data->{mergedwith}));
986 @newmergelist= sort { $a <=> $b } @newmergelist;
987 $action= "Forcibly Merged @newmergelist.";
988 delete @fixed{keys %found};
989 for $ref (@newmergelist) {
990 &getbug || die "huh ? $gBug $ref disappeared during merge";
991 &addmaintainers($data);
992 @bug_affected{@newmergelist} = 1 x @newmergelist;
993 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
994 $data->{keywords}= join(' ', keys %tags);
995 $data->{found_versions}= [sort keys %found];
996 $data->{fixed_versions}= [sort keys %fixed];
997 my @field_list = qw(forwarded package severity blocks blockedby owner done);
998 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1001 &transcript("$action\n\n");
1004 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1008 @newclonedids = split /\s+/, $2;
1009 $newbugsneeded = scalar(@newclonedids);
1012 $bug_affected{$ref} = 1;
1014 if (length($data->{mergedwith})) {
1015 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1019 &filelock("nextnumber.lock");
1020 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1021 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1022 $firstref= $v+0; $v += $newbugsneeded;
1023 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1026 $lastref = $firstref + $newbugsneeded - 1;
1028 if ($newbugsneeded == 1) {
1029 $action= "$gBug $origref cloned as bug $firstref.";
1031 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1034 my $blocks = $data->{blocks};
1035 my $blockedby = $data->{blockedby};
1038 my $ohash = get_hashname($origref);
1039 my $clone = $firstref;
1040 @bug_affected{@newclonedids} = 1 x @newclonedids;
1041 for $newclonedid (@newclonedids) {
1042 $clonebugs{$newclonedid} = $clone;
1044 my $hash = get_hashname($clone);
1045 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1046 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1047 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1048 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1049 &bughook('new', $clone, $data);
1051 # Update blocking info of bugs blocked by or blocking the
1053 foreach $ref (split ' ', $blocks) {
1055 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1058 foreach $ref (split ' ', $blockedby) {
1060 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1068 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
1070 my @pkgs = split /\s+/, $1;
1071 if (scalar(@pkgs) > 0) {
1072 %limit_pkgs = map { ($_, 1) } @pkgs;
1073 &transcript("Ignoring bugs not assigned to: " .
1074 join(" ", keys(%limit_pkgs)) . "\n\n");
1077 &transcript("Not ignoring any bugs.\n\n");
1079 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1080 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1083 $bug_affected{$ref} = 1;
1085 if (length $data->{owner}) {
1086 $action = "Owner changed from $data->{owner} to $newowner.";
1088 $action = "Owner recorded as $newowner.";
1090 if (length $data->{done}) {
1091 $extramessage = "(By the way, this $gBug is currently " .
1092 "marked as done.)\n";
1095 &addmaintainers($data);
1096 $data->{owner} = $newowner;
1097 } while (&getnextbug);
1099 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1102 $bug_affected{$ref} = 1;
1104 if (length $data->{owner}) {
1105 $action = "Removed annotation that $gBug was owned by " .
1108 &addmaintainers($data);
1109 $data->{owner} = '';
1110 } while (&getnextbug);
1112 &transcript("$gBug is not marked as having an owner.\n\n");
1117 &transcript("Unknown command or malformed arguments to command.\n\n");
1119 if (++$unknowns >= 5) {
1120 &transcript("Too many unknown commands, stopping here.\n\n");
1125 if ($procline>$#bodylines) {
1126 &transcript(">\nEnd of message, stopping processing here.\n\n");
1128 if (!$ok && !quickabort) {
1130 &transcript("No commands successfully parsed; sending the help text(s).\n");
1135 &transcript("MC\n") if $dl>1;
1137 for $maint (keys %maintccreasons) {
1138 &transcript("MM|$maint|\n") if $dl>1;
1139 next if $maint eq $replyto;
1141 $reasonsref= $maintccreasons{$maint};
1142 &transcript("MY|$maint|\n") if $dl>2;
1143 for $p (sort keys %$reasonsref) {
1144 &transcript("MP|$p|\n") if $dl>2;
1145 $reasonstring.= ', ' if length($reasonstring);
1146 $reasonstring.= $p.' ' if length($p);
1147 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1149 if (length($reasonstring) > 40) {
1150 (substr $reasonstring, 37) = "...";
1152 $reasonstring = "" if (!defined($reasonstring));
1153 push(@maintccs,"$maint ($reasonstring)");
1154 push(@maintccaddrs,"$maint");
1159 &transcript("MC|@maintccs|\n") if $dl>2;
1160 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1163 # Add Bcc's to subscribed bugs
1164 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1166 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1167 $header{'subject'} = "your mail";
1170 # Error text here advertises how many errors there were
1171 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1174 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1176 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1177 In-Reply-To: $header{'message-id'}
1178 References: $header{'message-id'}
1179 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1181 X-$gProject-PR-Message: transcript
1183 ${transcript}Please contact me if you need assistance.
1186 (administrator, $gProject $gBugs database)
1190 $repliedshow= join(', ',$replyto,@maintccaddrs);
1191 &filelock("lock/-1");
1192 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1194 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1196 "<strong>Request received</strong> from <code>".
1197 &sani($header{'from'})."</code>\n".
1198 "to <code>".&sani($controlrequestaddr)."</code>\n".
1200 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1201 close(AP) || &quit("open db-h/-1.log: $!");
1203 utime(time,time,"db-h");
1205 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1207 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1209 sub sendmailmessage {
1210 local ($message,@recips) = @_;
1211 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1212 send_mail_message(message => $message,
1213 recipients => \@recips,
1219 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1220 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1224 #sub unimplemented {
1225 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1229 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1231 if (@newmergelist) {
1232 eval "\$mvarvalue= \$$mvarname";
1233 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1236 "Values for \`$string' don't match:\n".
1237 " #$newmergelist[0] has \`$mvarvalue';\n".
1238 " #$ref has \`$svarvalue'\n"
1239 if $mvarvalue ne $svarvalue;
1241 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1243 eval "\$$mvarname= \$svarvalue";
1248 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1249 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1261 my %h = map { $_ => 1 } split ' ', $list;
1268 return join ' ', sort keys %h;
1271 # High-level bug manipulation calls
1272 # Do announcements themselves
1274 # Possible calling sequences:
1275 # setbug (returns 0)
1277 # setbug (returns 1)
1278 # &transcript(something)
1281 # setbug (returns 1)
1282 # $action= (something)
1284 # (modify s_* variables)
1285 # } while (getnextbug);
1288 &dlen("nochangebug");
1289 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1291 &endmerge if $manybugs;
1293 &dlex("nochangebug");
1297 &dlen("setbug $ref");
1298 if ($ref =~ m/^-\d+/) {
1299 if (!defined $clonebugs{$ref}) {
1301 &dlex("setbug => noclone");
1304 $ref = $clonebugs{$ref};
1306 $state eq 'idle' || die "$state ?";
1309 &dlex("setbug => 0s");
1313 if (!&checkpkglimit) {
1318 @thisbugmergelist= split(/ /,$data->{mergedwith});
1319 if (!@thisbugmergelist) {
1324 &dlex("setbug => 1s");
1333 &dlex("setbug => 0mc");
1337 $state= 'multiple'; $sref=$ref;
1338 &dlex("setbug => 1m");
1343 &dlen("getnextbug");
1344 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1346 if (!$manybugs || !@thisbugmergelist) {
1347 length($action) || die;
1348 &transcript("$action\n$extramessage\n");
1349 &endmerge if $manybugs;
1351 &dlex("getnextbug => 0");
1354 $ref= shift(@thisbugmergelist);
1355 &getbug || die "bug $ref disappeared";
1357 &dlex("getnextbug => 1");
1361 # Low-level bug-manipulation calls
1362 # Do no announcements
1364 # getbug (returns 0)
1366 # getbug (returns 1)
1370 # $action= (something)
1371 # getbug (returns 1)
1373 # getbug (returns 1)
1375 # [getbug (returns 0)]
1376 # &transcript("$action\n\n")
1379 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1380 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1384 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1385 &filelock('lock/merge');
1386 $mergelowstate='locked';
1392 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1394 $mergelowstate='idle';
1399 &dlen("getbug $ref");
1400 $lowstate eq 'idle' || die "$state ?";
1401 if (($data = &lockreadbug($ref))) {
1404 &dlex("getbug => 1");
1409 &dlex("getbug => 0");
1415 $lowstate eq 'open' || die "$state ?";
1422 &dlen("savebug $ref");
1423 $lowstate eq 'open' || die "$lowstate ?";
1424 length($action) || die;
1425 $ref == $sref || die "read $sref but saving $ref ?";
1426 my $hash = get_hashname($ref);
1427 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1430 "<strong>".&sani($action)."</strong>\n".
1431 "Request was from <code>".&sani($header{'from'})."</code>\n".
1432 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1434 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1435 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1436 unlockwritebug($ref, $data);
1443 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1448 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1452 print $_[0] if $debug;
1453 $transcript.= $_[0];
1460 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1461 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1477 sub sendtxthelpraw {
1478 local ($relpath,$description) = @_;
1480 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1481 while(<D>) { $doc.=$_; }
1483 &transcript("Sending $description in separate message.\n");
1484 &sendmailmessage(<<END.$doc,$replyto);
1485 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1487 Subject: $gProject $gBug help: $description
1488 References: $header{'message-id'}
1489 In-Reply-To: $header{'message-id'}
1490 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1492 X-$gProject-PR-Message: doc-text $relpath
1498 sub sendlynxdocraw {
1499 local ($relpath,$description) = @_;
1501 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1502 while(<L>) { $doc.=$_; }
1504 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1505 &transcript("Information ($description) is not available -\n".
1506 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1509 &transcript("Error getting $description (code $? $!):\n$doc\n");
1511 &transcript("Sending $description.\n");
1512 &sendmailmessage(<<END.$doc,$replyto);
1513 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1515 Subject: $gProject $gBugs information: $description
1516 References: $header{'message-id'}
1517 In-Reply-To: $header{'message-id'}
1518 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1520 X-$gProject-PR-Message: doc-html $relpath
1529 $maintccreasons{$cca}{''}{$ref}= 1;
1532 sub addmaintainers {
1533 # Data structure is:
1534 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1537 &ensuremaintainersloaded;
1538 $anymaintfound=0; $anymaintnotfound=0;
1539 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1541 $p =~ /([a-z0-9.+-]+)/;
1543 next unless defined $p;
1544 if (defined $gSubscriptionDomain) {
1545 if (defined($pkgsrc{$p})) {
1546 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1548 addbcc("$p\@$gSubscriptionDomain");
1551 if (defined $data->{severity} and defined $gStrongList and
1552 isstrongseverity($data->{severity})) {
1553 addbcc("$gStrongList\@$gListDomain");
1555 if (defined($maintainerof{$p})) {
1556 $addmaint= $maintainerof{$p};
1557 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1558 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1559 print "maintainer add >$p|$addmaint<\n" if $debug;
1561 print "maintainer none >$p<\n" if $debug;
1562 &transcript("Warning: Unknown package '$p'\n");
1563 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1564 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1568 if (length $data->{owner}) {
1569 $addmaint = $data->{owner};
1570 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1571 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1572 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1576 sub ensuremaintainersloaded {
1578 return if $maintainersloaded++;
1579 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1583 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1584 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1585 $maintainerof{$a}= $2;
1588 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1592 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1593 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1594 $maintainerof{$a}= $2;
1597 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1599 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1600 my ($a, $b) = ($1, $2);
1601 $pkgsrc{lc($a)} = $b;
1607 local ($wherefrom,$path,$description) = @_;
1608 if ($wherefrom eq "ftp.d.o") {
1609 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1611 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1612 &transcript("$description is not available.\n");
1615 &transcript("Error getting $description (code $? $!):\n$doc\n");
1618 } elsif ($wherefrom eq "local") {
1620 $doc = do { local $/; <P> };
1623 &transcript("internal errror: info files location unknown.\n");
1626 &transcript("Sending $description.\n");
1627 &sendmailmessage(<<END.$doc,$replyto);
1628 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1630 Subject: $gProject $gBugs information: $description
1631 References: $header{'message-id'}
1632 In-Reply-To: $header{'message-id'}
1633 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1635 X-$gProject-PR-Message: getinfo
1637 $description follows: