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 $config_path = '/etc/debbugs';
14 $lib_path = '/usr/lib/debbugs';
16 require "$config_path/config";
17 require "$lib_path/errorlib";
18 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
20 chdir("$gSpoolDir") || die "chdir spool: $!\n";
23 open DEBUG, ">/dev/null";
28 m/^[RC]\.\d+$/ || &quit("bad argument");
31 if (!rename("incoming/G$nn","incoming/P$nn")) {
32 $_=$!.''; m/no such file or directory/i && exit 0;
33 &quit("renaming to lock: $!");
36 open(M,"incoming/P$nn");
43 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
45 my $parser = new MIME::Parser;
46 mkdir "$gSpoolDir/mime.tmp", 0777;
47 $parser->output_under("$gSpoolDir/mime.tmp");
48 my $entity = eval { $parser->parse_data(join('',@log)) };
50 # header and decoded body respectively
51 my (@headerlines, @bodylines);
52 # Bug numbers to send e-mail to, hash so that we don't send to the
56 if ($entity and $entity->head->tags) {
57 @headerlines = @{$entity->head->header};
60 my $entity_body = getmailbody($entity);
61 @bodylines = $entity_body ? $entity_body->as_lines() : ();
64 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
66 for ($i = 0; $i <= $#msg; $i++) {
68 last unless length($_);
69 while ($msg[$i+1] =~ m/^\s/) {
73 push @headerlines, $_;
76 @bodylines = @msg[$i..$#msg];
80 $_ = decode_rfc1522($_);
82 print ">$_<\n" if $debug;
85 print ">$v=$_<\n" if $debug;
88 print "!>$_<\n" if $debug;
92 # Strip off RFC2440-style PGP clearsigning.
93 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
94 shift @bodylines while @bodylines and length $bodylines[0];
95 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
96 for my $findsig (0 .. $#bodylines) {
97 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
98 $#bodylines = $findsig - 1;
102 map { s/^- // } @bodylines;
105 grep(s/\s+$//,@bodylines);
107 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
109 if (defined $header{'resent-from'} && !defined $header{'from'}) {
110 $header{'from'} = $header{'resent-from'};
113 defined($header{'from'}) || &quit("no From header");
115 delete $header{'reply-to'}
116 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
118 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
119 $replyto = $header{'reply-to'};
121 $replyto = $header{'from'};
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");
186 $ok++; # well, it's not really ok, but it fixes #81224 :)
187 } elsif (m/^index-summary\s+by-package$/i) {
188 &transcript("This BTS function is currently disabled, sorry.\n\n");
189 $ok++; # well, it's not really ok, but it fixes #81224 :)
190 } elsif (m/^index-summary(\s+by-number)?$/i) {
191 &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(\s+|-)pack(age)?s?$/i) {
194 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
195 } elsif (m/^index(\s+|-)maints?$/i) {
196 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
197 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
199 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
200 "$gBug list for maintainer \`$maint'");
202 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
204 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
205 "$gBug list for package $package");
207 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
208 &transcript("This BTS function is currently disabled, sorry.\n\n");
209 $ok++; # well, it's not really ok, but it fixes #81224 :)
210 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
211 &transcript("This BTS function is currently disabled, sorry.\n\n");
212 $ok++; # well, it's not really ok, but it fixes #81224 :)
213 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
214 &transcript("This BTS function is currently disabled, sorry.\n\n");
215 $ok++; # well, it's not really ok, but it fixes #81224 :)
216 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
217 # the following is basically a Debian-specific kludge, but who cares
219 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
220 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
221 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
223 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
224 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
225 &sendinfo("local", "$gConfigDir/$req", "$req file");
227 &transcript("Info file $req does not exist.\n\n");
229 } elsif (m/^help/i) {
233 } elsif (m/^refcard/i) {
234 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
235 } elsif (m/^subscribe/i) {
237 There is no $gProject $gBug mailing list. If you wish to review bug reports
238 please do so via http://$gWebDomain/ or ask this mail server
240 soon: MAILINGLISTS_TEXT
242 } elsif (m/^unsubscribe/i) {
244 soon: UNSUBSCRIBE_TEXT
245 soon: MAILINGLISTS_TEXT
247 } elsif (m/^user\s+(\S+)\s*$/i) {
249 if (Debbugs::User::is_valid_user($newuser)) {
250 my $olduser = ($user ne "" ? " (was $user)" : "");
251 &transcript("Setting user to $newuser$olduser.\n");
254 &transcript("Selected user id ($newuser) invalid, sorry\n");
257 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
260 my $hidden = ($2 ne "");
266 while (++$procline <= $#bodylines) {
267 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
271 &transcript("> $bodylines[$procline]\n");
273 my ($o, $txt) = ($1, $2);
274 if ($#cats == -1 && $o eq "+") {
275 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
280 unless (ref($cats[-1]) eq "HASH") {
281 $cats[-1] = { "nam" => $cats[-1],
282 "pri" => [], "ttl" => [] };
285 my ($desc, $ord, $op);
286 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
287 $desc = $1; $ord = $3; $op = "";
288 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
289 $desc = $1; $ord = $3; $op = $4;
290 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
291 $desc = ""; $op = $1;
293 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
297 $ord = 999 unless defined $ord;
300 push @{$cats[-1]->{"pri"}}, $prefix . $op;
301 push @{$cats[-1]->{"ttl"}}, $desc;
302 push @ords, "$ord $catsec";
304 @cats[-1]->{"def"} = $desc;
305 push @ords, "$ord DEF";
308 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
309 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
310 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
311 } elsif ($o eq "*") {
314 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
315 $name = $1; $prefix = $3;
317 $name = $txt; $prefix = "";
322 # XXX: got @cats, now do something with it
323 my $u = Debbugs::User::get_user($user);
325 &transcript("Added usercategory $catname.\n\n");
326 $u->{"categories"}->{$catname} = [ @cats ];
328 &transcript("Removed usercategory $catname.\n\n");
329 delete $u->{"categories"}->{$catname};
332 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
334 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
336 &transcript("No valid user selected\n");
340 Debbugs::User::read_usertags(\%ut, $user);
341 my @oldtags = (); my @newtags = (); my @badtags = ();
343 for my $t (split /[,\s]+/, $tags) {
344 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
351 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
353 for my $t (keys %chtags) {
354 $ut{$t} = [] unless defined $ut{$t};
356 for my $t (keys %ut) {
357 my %res = map { ($_, 1) } @{$ut{$t}};
358 push @oldtags, $t if defined $res{$ref};
359 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
360 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
361 : $addsubcode eq "=");
362 $res{$ref} = 1 if ($addop && defined $chtags{$t});
363 delete $res{$ref} if ($del);
364 push @newtags, $t if defined $res{$ref};
365 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
368 &transcript("There were no usertags set.\n");
370 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
372 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
373 Debbugs::User::write_usertags(\%ut, $user);
375 } elsif (!$control) {
377 Unknown command or malformed arguments to command.
378 (Use control\@$gEmailDomain to manipulate reports.)
381 if (++$unknowns >= 3) {
382 &transcript("Too many unknown commands, stopping here.\n\n");
385 #### "developer only" ones start here
386 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
389 $bug_affected{$ref}=1;
392 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
393 if (length($data->{done}) and not defined($version)) {
394 &transcript("$gBug is already closed, cannot re-close.\n\n");
399 "marked as fixed in version $version" :
401 ", send any further explanations to $data->{originator}";
403 &addmaintainers($data);
404 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
405 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
406 $data->{done}= $replyto;
407 my @keywords= split ' ', $data->{keywords};
408 if (grep $_ eq 'pending', @keywords) {
409 $extramessage= "Removed pending tag.\n";
410 $data->{keywords}= join ' ', grep $_ ne 'pending',
413 addfixedversions($data, $data->{package}, $version, 'binary');
416 From: $gMaintainerEmail ($gProject $gBug Tracking System)
417 To: $data->{originator}
418 Subject: $gBug#$ref acknowledged by developer
420 References: $header{'message-id'} $data->{msgid}
421 In-Reply-To: $data->{msgid}
422 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
423 Reply-To: $ref\@$gEmailDomain
424 X-$gProject-PR-Message: they-closed-control $ref
426 This is an automatic notification regarding your $gBug report
427 #$ref: $data->{subject},
428 which was filed against the $data->{package} package.
430 It has been marked as closed by one of the developers, namely
433 You should be hearing from them with a substantive response shortly,
434 in case you haven't already. If not, please contact them directly.
437 (administrator, $gProject $gBugs database)
440 &sendmailmessage($message,$data->{originator});
441 } while (&getnextbug);
444 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
446 $ref= $1; $newpackage= $2;
447 $bug_affected{$ref}=1;
449 $newpackage =~ y/A-Z/a-z/;
451 if (length($data->{package})) {
452 $action= "$gBug reassigned from package \`$data->{package}'".
453 " to \`$newpackage'.";
455 $action= "$gBug assigned to package \`$newpackage'.";
458 &addmaintainers($data);
459 $data->{package}= $newpackage;
460 $data->{found_versions}= [];
461 $data->{fixed_versions}= [];
462 # TODO: what if $newpackage is a source package?
463 addfoundversions($data, $data->{package}, $version, 'binary');
464 &addmaintainers($data);
465 } while (&getnextbug);
467 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
468 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
469 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
470 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
473 $bug_affected{$ref}=1;
475 if (@{$data->{fixed_versions}}) {
476 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
478 if (!length($data->{done})) {
479 &transcript("$gBug is already open, cannot reopen.\n\n");
483 $noriginator eq '' ? "$gBug reopened, originator not changed." :
484 "$gBug reopened, originator set to $noriginator.";
486 &addmaintainers($data);
487 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
488 $data->{fixed_versions}= [];
490 } while (&getnextbug);
493 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
498 if (!length($data->{done}) and not defined($version)) {
499 &transcript("$gBug is already open, cannot reopen.\n\n");
504 "$gBug marked as found in version $version." :
507 &addmaintainers($data);
508 # The 'done' field gets a bit weird with version
509 # tracking, because a bug may be closed by multiple
510 # people in different branches. Until we have something
511 # more flexible, we set it every time a bug is fixed,
512 # and clear it precisely when a found command is
513 # received for the rightmost fixed-in version, which
514 # equates to the most recent fixing of the bug, or when
515 # a versionless found command is received.
516 if (defined $version) {
517 my $lastfixed = $data->{fixed_versions}[-1];
518 # TODO: what if $data->{package} is a source package?
519 addfoundversions($data, $data->{package}, $version, 'binary');
520 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
524 # Versionless found; assume old-style "not fixed at
526 $data->{fixed_versions} = [];
529 } while (&getnextbug);
532 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
537 $action= "$gBug marked as not found in version $version.";
538 if (length($data->{done})) {
539 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
542 &addmaintainers($data);
543 removefoundversions($data, $data->{package}, $version, 'binary');
544 } while (&getnextbug);
546 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
547 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
550 $bug_affected{$ref}=1;
551 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
552 $ref = $clonebugs{$ref};
555 if (&checkpkglimit) {
557 &addmaintainers($data);
558 $oldsubmitter= $data->{originator};
559 $data->{originator}= $newsubmitter;
560 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
562 &transcript("$action\n");
563 if (length($data->{done})) {
564 &transcript("(By the way, that $gBug is currently marked as done.)\n");
568 From: $gMaintainerEmail ($gProject $gBug Tracking System)
570 Subject: $gBug#$ref submitter address changed
572 References: $header{'message-id'} $data->{msgid}
573 In-Reply-To: $data->{msgid}
574 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
575 Reply-To: $ref\@$gEmailDomain
576 X-$gProject-PR-Message: submitter-changed $ref
578 The submitter address recorded for your $gBug report
579 #$ref: $data->{subject}
582 The old submitter address for this report was
584 The new submitter address is
587 This change was made by
589 If it was incorrect, please contact them directly.
592 (administrator, $gProject $gBugs database)
595 &sendmailmessage($message,$oldsubmitter);
602 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
604 $ref= $1; $whereto= $2;
605 $bug_affected{$ref}=1;
607 if (length($data->{forwarded})) {
608 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
610 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
612 if (length($data->{done})) {
613 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
616 &addmaintainers($data);
617 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
618 &addccaddress("$gForwardList\@$gListDomain");
620 $data->{forwarded}= $whereto;
621 } while (&getnextbug);
623 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
626 $bug_affected{$ref}=1;
628 if (!length($data->{forwarded})) {
629 &transcript("$gBug is not marked as having been forwarded.\n\n");
632 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
634 &addmaintainers($data);
635 $data->{forwarded}= '';
636 } while (&getnextbug);
639 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
640 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
643 $bug_affected{$ref}=1;
645 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
646 &transcript("Severity level \`$newseverity' is not known.\n".
647 "Recognized are: $gShowSeverities.\n\n");
648 } elsif (exists $gObsoleteSeverities{$newseverity}) {
649 &transcript("Severity level \`$newseverity' is obsolete. " .
650 "$gObsoleteSeverities{$newseverity}\n\n");
652 $printseverity= $data->{severity};
653 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
654 $action= "Severity set to \`$newseverity' from \`$printseverity'";
656 &addmaintainers($data);
657 if (defined $gStrongList and isstrongseverity($newseverity)) {
658 addbcc("$gStrongList\@$gListDomain");
660 $data->{severity}= $newseverity;
661 } while (&getnextbug);
663 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
665 $ref = $1; $addsubcode = $3; $tags = $4;
666 $bug_affected{$ref}=1;
668 if (defined $addsubcode) {
669 $addsub = "sub" if ($addsubcode eq "-");
670 $addsub = "add" if ($addsubcode eq "+");
671 $addsub = "set" if ($addsubcode eq "=");
675 foreach my $t (split /[\s,]+/, $tags) {
676 if (!grep($_ eq $t, @gTags)) {
683 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
684 "Recognized are: ".join(' ', @gTags).".\n\n");
687 if ($data->{keywords} eq '') {
688 &transcript("There were no tags set.\n");
690 &transcript("Tags were: $data->{keywords}\n");
692 if ($addsub eq "set") {
693 $action= "Tags set to: " . join(", ", @okaytags);
694 } elsif ($addsub eq "add") {
695 $action= "Tags added: " . join(", ", @okaytags);
696 } elsif ($addsub eq "sub") {
697 $action= "Tags removed: " . join(", ", @okaytags);
700 &addmaintainers($data);
701 $data->{keywords} = '' if ($addsub eq "set");
702 # Allow removing obsolete tags.
703 if ($addsub eq "sub") {
704 foreach my $t (@badtags) {
705 $data->{keywords} = join ' ', grep $_ ne $t,
706 split ' ', $data->{keywords};
709 # Now process all other additions and subtractions.
710 foreach my $t (@okaytags) {
711 $data->{keywords} = join ' ', grep $_ ne $t,
712 split ' ', $data->{keywords};
713 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
715 $data->{keywords} =~ s/\s*$//;
716 } while (&getnextbug);
718 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
720 my $bugnum = $2; my $blockers = $4;
722 $addsub = "sub" if ($1 eq "un");
723 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
724 $bugnum = $clonebugs{$bugnum};
729 foreach my $b (split /[\s,]+/, $blockers) {
733 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
734 $ref = $clonebugs{$ref};
737 push @okayblockers, $ref;
739 # add to the list all bugs that are merged with $b,
740 # because all of their data must be kept in sync
741 @thisbugmergelist= split(/ /,$data->{mergedwith});
744 foreach $ref (@thisbugmergelist) {
746 push @okayblockers, $ref;
753 push @badblockers, $ref;
757 push @badblockers, $b;
761 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
766 if ($data->{blockedby} eq '') {
767 &transcript("Was not blocked by any bugs.\n");
769 &transcript("Was blocked by: $data->{blockedby}\n");
771 if ($addsub eq "set") {
772 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
773 } elsif ($addsub eq "add") {
774 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
775 } elsif ($addsub eq "sub") {
776 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
781 &addmaintainers($data);
782 my @oldblockerlist = split ' ', $data->{blockedby};
783 $data->{blockedby} = '' if ($addsub eq "set");
784 foreach my $b (@okayblockers) {
785 $data->{blockedby} = manipset($data->{blockedby}, $b,
789 foreach my $b (@oldblockerlist) {
790 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
791 push @{$removedblocks{$b}}, $ref;
794 foreach my $b (split ' ', $data->{blockedby}) {
795 if (! grep { $_ eq $b } @oldblockerlist) {
796 push @{$addedblocks{$b}}, $ref;
799 } while (&getnextbug);
801 # Now that the blockedby data is updated, change blocks data
802 # to match the changes.
803 foreach $ref (keys %addedblocks) {
805 foreach my $b (@{$addedblocks{$ref}}) {
806 $data->{blocks} = manipset($data->{blocks}, $b, 1);
811 foreach $ref (keys %removedblocks) {
813 foreach my $b (@{$removedblocks{$ref}}) {
814 $data->{blocks} = manipset($data->{blocks}, $b, 0);
820 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
822 $ref= $1; $newtitle= $2;
823 $bug_affected{$ref}=1;
824 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
825 $ref = $clonebugs{$ref};
828 if (&checkpkglimit) {
830 &addmaintainers($data);
831 $data->{subject}= $newtitle;
832 $action= "Changed $gBug title.";
834 &transcript("$action\n");
835 if (length($data->{done})) {
836 &transcript("(By the way, that $gBug is currently marked as done.)\n");
845 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
848 $bug_affected{$ref} = 1;
850 if (!length($data->{mergedwith})) {
851 &transcript("$gBug is not marked as being merged with any others.\n\n");
854 $mergelowstate eq 'locked' || die "$mergelowstate ?";
855 $action= "Disconnected #$ref from all other report(s).";
856 @newmergelist= split(/ /,$data->{mergedwith});
858 @bug_affected{@newmergelist} = 1 x @newmergelist;
860 &addmaintainers($data);
861 $data->{mergedwith}= ($ref == $discref) ? ''
862 : join(' ',grep($_ ne $ref,@newmergelist));
863 } while (&getnextbug);
866 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
868 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
869 my @newmergelist= ();
874 while (defined($ref= shift(@tomerge))) {
875 &transcript("D| checking merge $ref\n") if $dl;
877 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
878 $ref = $clonebugs{$ref};
880 next if grep($_ == $ref,@newmergelist);
881 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
882 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
884 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
886 &checkmatch('package','m_package',$data->{package},@newmergelist);
887 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
888 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
889 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
890 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
891 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
892 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
893 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
894 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
895 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
896 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
897 if (length($mismatch)) {
898 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
900 &cancelbug; @newmergelist=(); last;
902 push(@newmergelist,$ref);
903 push(@tomerge,split(/ /,$data->{mergedwith}));
907 @newmergelist= sort { $a <=> $b } @newmergelist;
908 $action= "Merged @newmergelist.";
909 delete @fixed{keys %found};
910 for $ref (@newmergelist) {
911 &getbug || die "huh ? $gBug $ref disappeared during merge";
912 &addmaintainers($data);
913 @bug_affected{@newmergelist} = 1 x @newmergelist;
914 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
915 $data->{keywords}= join(' ', keys %tags);
916 $data->{found_versions}= [sort keys %found];
917 $data->{fixed_versions}= [sort keys %fixed];
920 &transcript("$action\n\n");
923 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
925 my @temp = split /\s+\#?/,$1;
926 my $master_bug = shift @temp;
928 my @tomerge = sort { $a <=> $b } @temp;
929 unshift @tomerge,$master_bug;
930 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
931 my @newmergelist= ();
935 # Here we try to do the right thing.
936 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
937 # If not, we discard the found and fixed.
938 # Everything else we set to the values of the first bug.
940 while (defined($ref= shift(@tomerge))) {
941 &transcript("D| checking merge $ref\n") if $dl;
943 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
944 $ref = $clonebugs{$ref};
946 next if grep($_ == $ref,@newmergelist);
947 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
948 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
950 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
951 $master_bug_data = $data if not defined $master_bug_data;
952 if ($data->{package} ne $master_bug_data->{package}) {
953 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
954 "$gBug $ref is not in the same package as $master_bug\n");
955 &cancelbug; @newmergelist=(); last;
957 for my $t (split /\s+/,$data->{keywords}) {
960 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
961 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
962 push(@newmergelist,$ref);
963 push(@tomerge,split(/ /,$data->{mergedwith}));
967 @newmergelist= sort { $a <=> $b } @newmergelist;
968 $action= "Forcibly Merged @newmergelist.";
969 delete @fixed{keys %found};
970 for $ref (@newmergelist) {
971 &getbug || die "huh ? $gBug $ref disappeared during merge";
972 &addmaintainers($data);
973 @bug_affected{@newmergelist} = 1 x @newmergelist;
974 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
975 $data->{keywords}= join(' ', keys %tags);
976 $data->{found_versions}= [sort keys %found];
977 $data->{fixed_versions}= [sort keys %fixed];
978 my @field_list = qw(forwarded package severity blocks blockedby owner done);
979 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
982 &transcript("$action\n\n");
985 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
989 @newclonedids = split /\s+/, $2;
990 $newbugsneeded = scalar(@newclonedids);
993 $bug_affected{$ref} = 1;
995 if (length($data->{mergedwith})) {
996 &transcript("$gBug is marked as being merged with others.\n\n");
999 &filelock("nextnumber.lock");
1000 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1001 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1002 $firstref= $v+0; $v += $newbugsneeded;
1003 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1006 $lastref = $firstref + $newbugsneeded - 1;
1008 if ($newbugsneeded == 1) {
1009 $action= "$gBug $origref cloned as bug $firstref.";
1011 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1014 my $blocks = $data->{blocks};
1015 my $blockedby = $data->{blockedby};
1018 my $ohash = get_hashname($origref);
1019 my $clone = $firstref;
1020 @bug_affected{@newclonedids} = 1 x @newclonedids;
1021 for $newclonedid (@newclonedids) {
1022 $clonebugs{$newclonedid} = $clone;
1024 my $hash = get_hashname($clone);
1025 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1026 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1027 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1028 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1029 &bughook('new', $clone, $data);
1031 # Update blocking info of bugs blocked by or blocking the
1033 foreach $ref (split ' ', $blocks) {
1035 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1038 foreach $ref (split ' ', $blockedby) {
1040 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1048 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
1050 my @pkgs = split /\s+/, $1;
1051 if (scalar(@pkgs) > 0) {
1052 %limit_pkgs = map { ($_, 1) } @pkgs;
1053 &transcript("Ignoring bugs not assigned to: " .
1054 join(" ", keys(%limit_pkgs)) . "\n\n");
1057 &transcript("Not ignoring any bugs.\n\n");
1059 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1060 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1063 $bug_affected{$ref} = 1;
1065 if (length $data->{owner}) {
1066 $action = "Owner changed from $data->{owner} to $newowner.";
1068 $action = "Owner recorded as $newowner.";
1070 if (length $data->{done}) {
1071 $extramessage = "(By the way, this $gBug is currently " .
1072 "marked as done.)\n";
1075 &addmaintainers($data);
1076 $data->{owner} = $newowner;
1077 } while (&getnextbug);
1079 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1082 $bug_affected{$ref} = 1;
1084 if (length $data->{owner}) {
1085 $action = "Removed annotation that $gBug was owned by " .
1088 &addmaintainers($data);
1089 $data->{owner} = '';
1090 } while (&getnextbug);
1092 &transcript("$gBug is not marked as having an owner.\n\n");
1097 &transcript("Unknown command or malformed arguments to command.\n\n");
1098 if (++$unknowns >= 5) {
1099 &transcript("Too many unknown commands, stopping here.\n\n");
1104 if ($procline>$#bodylines) {
1105 &transcript(">\nEnd of message, stopping processing here.\n\n");
1107 if (!$ok && !quickabort) {
1108 &transcript("No commands successfully parsed; sending the help text(s).\n");
1113 &transcript("MC\n") if $dl>1;
1115 for $maint (keys %maintccreasons) {
1116 &transcript("MM|$maint|\n") if $dl>1;
1117 next if $maint eq $replyto;
1119 $reasonsref= $maintccreasons{$maint};
1120 &transcript("MY|$maint|\n") if $dl>2;
1121 for $p (sort keys %$reasonsref) {
1122 &transcript("MP|$p|\n") if $dl>2;
1123 $reasonstring.= ', ' if length($reasonstring);
1124 $reasonstring.= $p.' ' if length($p);
1125 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1127 if (length($reasonstring) > 40) {
1128 (substr $reasonstring, 37) = "...";
1130 $reasonstring = "" if (!defined($reasonstring));
1131 push(@maintccs,"$maint ($reasonstring)");
1132 push(@maintccaddrs,"$maint");
1137 &transcript("MC|@maintccs|\n") if $dl>2;
1138 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1141 # Add Bcc's to subscribed bugs
1142 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1144 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1145 $header{'subject'} = "your mail";
1149 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1151 ${maintccs}Subject: Processed: $header{'subject'}
1152 In-Reply-To: $header{'message-id'}
1153 References: $header{'message-id'}
1154 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1156 X-$gProject-PR-Message: transcript
1158 ${transcript}Please contact me if you need assistance.
1161 (administrator, $gProject $gBugs database)
1165 $repliedshow= join(', ',$replyto,@maintccaddrs);
1166 &filelock("lock/-1");
1167 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1169 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1171 "<strong>Request received</strong> from <code>".
1172 &sani($header{'from'})."</code>\n".
1173 "to <code>".&sani($controlrequestaddr)."</code>\n".
1175 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1176 close(AP) || &quit("open db-h/-1.log: $!");
1178 utime(time,time,"db-h");
1180 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1182 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1184 sub sendmailmessage {
1185 local ($message,@recips) = @_;
1186 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1187 send_mail_message(message => $message,
1188 recipients => \@recips,
1194 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1195 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1199 #sub unimplemented {
1200 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1204 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1206 if (@newmergelist) {
1207 eval "\$mvarvalue= \$$mvarname";
1208 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1211 "Values for \`$string' don't match:\n".
1212 " #$newmergelist[0] has \`$mvarvalue';\n".
1213 " #$ref has \`$svarvalue'\n"
1214 if $mvarvalue ne $svarvalue;
1216 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1218 eval "\$$mvarname= \$svarvalue";
1223 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1224 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1235 my %h = map { $_ => 1 } split ' ', $list;
1242 return join ' ', sort keys %h;
1245 # High-level bug manipulation calls
1246 # Do announcements themselves
1248 # Possible calling sequences:
1249 # setbug (returns 0)
1251 # setbug (returns 1)
1252 # &transcript(something)
1255 # setbug (returns 1)
1256 # $action= (something)
1258 # (modify s_* variables)
1259 # } while (getnextbug);
1262 &dlen("nochangebug");
1263 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1265 &endmerge if $manybugs;
1267 &dlex("nochangebug");
1271 &dlen("setbug $ref");
1272 if ($ref =~ m/^-\d+/) {
1273 if (!defined $clonebugs{$ref}) {
1275 &dlex("setbug => noclone");
1278 $ref = $clonebugs{$ref};
1280 $state eq 'idle' || die "$state ?";
1283 &dlex("setbug => 0s");
1287 if (!&checkpkglimit) {
1292 @thisbugmergelist= split(/ /,$data->{mergedwith});
1293 if (!@thisbugmergelist) {
1298 &dlex("setbug => 1s");
1307 &dlex("setbug => 0mc");
1311 $state= 'multiple'; $sref=$ref;
1312 &dlex("setbug => 1m");
1317 &dlen("getnextbug");
1318 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1320 if (!$manybugs || !@thisbugmergelist) {
1321 length($action) || die;
1322 &transcript("$action\n$extramessage\n");
1323 &endmerge if $manybugs;
1325 &dlex("getnextbug => 0");
1328 $ref= shift(@thisbugmergelist);
1329 &getbug || die "bug $ref disappeared";
1331 &dlex("getnextbug => 1");
1335 # Low-level bug-manipulation calls
1336 # Do no announcements
1338 # getbug (returns 0)
1340 # getbug (returns 1)
1344 # $action= (something)
1345 # getbug (returns 1)
1347 # getbug (returns 1)
1349 # [getbug (returns 0)]
1350 # &transcript("$action\n\n")
1353 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1354 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1358 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1359 &filelock('lock/merge');
1360 $mergelowstate='locked';
1366 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1368 $mergelowstate='idle';
1373 &dlen("getbug $ref");
1374 $lowstate eq 'idle' || die "$state ?";
1375 if (($data = &lockreadbug($ref))) {
1378 &dlex("getbug => 1");
1383 &dlex("getbug => 0");
1389 $lowstate eq 'open' || die "$state ?";
1396 &dlen("savebug $ref");
1397 $lowstate eq 'open' || die "$lowstate ?";
1398 length($action) || die;
1399 $ref == $sref || die "read $sref but saving $ref ?";
1400 my $hash = get_hashname($ref);
1401 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1404 "<strong>".&sani($action)."</strong>\n".
1405 "Request was from <code>".&sani($header{'from'})."</code>\n".
1406 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1408 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1409 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1410 unlockwritebug($ref, $data);
1417 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1422 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1426 print $_[0] if $debug;
1427 $transcript.= $_[0];
1434 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1435 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1451 sub sendtxthelpraw {
1452 local ($relpath,$description) = @_;
1454 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1455 while(<D>) { $doc.=$_; }
1457 &transcript("Sending $description in separate message.\n");
1458 &sendmailmessage(<<END.$doc,$replyto);
1459 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1461 Subject: $gProject $gBug help: $description
1462 References: $header{'message-id'}
1463 In-Reply-To: $header{'message-id'}
1464 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1466 X-$gProject-PR-Message: doc-text $relpath
1472 sub sendlynxdocraw {
1473 local ($relpath,$description) = @_;
1475 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1476 while(<L>) { $doc.=$_; }
1478 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1479 &transcript("Information ($description) is not available -\n".
1480 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1483 &transcript("Error getting $description (code $? $!):\n$doc\n");
1485 &transcript("Sending $description.\n");
1486 &sendmailmessage(<<END.$doc,$replyto);
1487 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1489 Subject: $gProject $gBugs information: $description
1490 References: $header{'message-id'}
1491 In-Reply-To: $header{'message-id'}
1492 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1494 X-$gProject-PR-Message: doc-html $relpath
1503 $maintccreasons{$cca}{''}{$ref}= 1;
1506 sub addmaintainers {
1507 # Data structure is:
1508 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1511 &ensuremaintainersloaded;
1512 $anymaintfound=0; $anymaintnotfound=0;
1513 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1515 $p =~ /([a-z0-9.+-]+)/;
1517 next unless defined $p;
1518 if (defined $gSubscriptionDomain) {
1519 if (defined($pkgsrc{$p})) {
1520 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1522 addbcc("$p\@$gSubscriptionDomain");
1525 if (defined $data->{severity} and defined $gStrongList and
1526 isstrongseverity($data->{severity})) {
1527 addbcc("$gStrongList\@$gListDomain");
1529 if (defined($maintainerof{$p})) {
1530 $addmaint= $maintainerof{$p};
1531 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1532 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1533 print "maintainer add >$p|$addmaint<\n" if $debug;
1535 print "maintainer none >$p<\n" if $debug;
1536 &transcript("Warning: Unknown package '$p'\n");
1537 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1538 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1542 if (length $data->{owner}) {
1543 $addmaint = $data->{owner};
1544 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1545 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1546 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1550 sub ensuremaintainersloaded {
1552 return if $maintainersloaded++;
1553 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1557 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1558 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1559 $maintainerof{$a}= $2;
1562 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1566 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1567 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1568 $maintainerof{$a}= $2;
1571 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1573 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1574 my ($a, $b) = ($1, $2);
1575 $pkgsrc{lc($a)} = $b;
1581 local ($wherefrom,$path,$description) = @_;
1582 if ($wherefrom eq "ftp.d.o") {
1583 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1585 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1586 &transcript("$description is not available.\n");
1589 &transcript("Error getting $description (code $? $!):\n$doc\n");
1592 } elsif ($wherefrom eq "local") {
1594 $doc = do { local $/; <P> };
1597 &transcript("internal errror: info files location unknown.\n");
1600 &transcript("Sending $description.\n");
1601 &sendmailmessage(<<END.$doc,$replyto);
1602 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1604 Subject: $gProject $gBugs information: $description
1605 References: $header{'message-id'}
1606 In-Reply-To: $header{'message-id'}
1607 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1609 X-$gProject-PR-Message: getinfo
1611 $description follows: