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/i || m/^quit/i || m/^--/ || m/^thank/i || m/^kthxbye/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");
339 Debbugs::User::read_usertags(\%ut, $user);
340 my @oldtags = (); my @newtags = (); my @badtags = ();
342 for my $t (split /[,\s]+/, $tags) {
343 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
350 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
352 for my $t (keys %chtags) {
353 $ut{$t} = [] unless defined $ut{$t};
355 for my $t (keys %ut) {
356 my %res = map { ($_, 1) } @{$ut{$t}};
357 push @oldtags, $t if defined $res{$ref};
358 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
359 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
360 : $addsubcode eq "=");
361 $res{$ref} = 1 if ($addop && defined $chtags{$t});
362 delete $res{$ref} if ($del);
363 push @newtags, $t if defined $res{$ref};
364 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
367 &transcript("There were no usertags set.\n");
369 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
371 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
372 Debbugs::User::write_usertags(\%ut, $user);
374 } elsif (!$control) {
376 Unknown command or malformed arguments to command.
377 (Use control\@$gEmailDomain to manipulate reports.)
380 if (++$unknowns >= 3) {
381 &transcript("Too many unknown commands, stopping here.\n\n");
384 #### "developer only" ones start here
385 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
388 $bug_affected{$ref}=1;
391 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
392 if (length($data->{done}) and not defined($version)) {
393 &transcript("$gBug is already closed, cannot re-close.\n\n");
398 "marked as fixed in version $version" :
400 ", send any further explanations to $data->{originator}";
402 &addmaintainers($data);
403 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
404 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
405 $data->{done}= $replyto;
406 my @keywords= split ' ', $data->{keywords};
407 if (grep $_ eq 'pending', @keywords) {
408 $extramessage= "Removed pending tag.\n";
409 $data->{keywords}= join ' ', grep $_ ne 'pending',
412 addfixedversions($data, $data->{package}, $version, 'binary');
415 From: $gMaintainerEmail ($gProject $gBug Tracking System)
416 To: $data->{originator}
417 Subject: $gBug#$ref acknowledged by developer
419 References: $header{'message-id'} $data->{msgid}
420 In-Reply-To: $data->{msgid}
421 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
422 Reply-To: $ref\@$gEmailDomain
423 X-$gProject-PR-Message: they-closed-control $ref
425 This is an automatic notification regarding your $gBug report
426 #$ref: $data->{subject},
427 which was filed against the $data->{package} package.
429 It has been marked as closed by one of the developers, namely
432 You should be hearing from them with a substantive response shortly,
433 in case you haven't already. If not, please contact them directly.
436 (administrator, $gProject $gBugs database)
439 &sendmailmessage($message,$data->{originator});
440 } while (&getnextbug);
443 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
445 $ref= $1; $newpackage= $2;
446 $bug_affected{$ref}=1;
448 $newpackage =~ y/A-Z/a-z/;
450 if (length($data->{package})) {
451 $action= "$gBug reassigned from package \`$data->{package}'".
452 " to \`$newpackage'.";
454 $action= "$gBug assigned to package \`$newpackage'.";
457 &addmaintainers($data);
458 $data->{package}= $newpackage;
459 $data->{found_versions}= [];
460 $data->{fixed_versions}= [];
461 # TODO: what if $newpackage is a source package?
462 addfoundversions($data, $data->{package}, $version, 'binary');
463 &addmaintainers($data);
464 } while (&getnextbug);
466 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
467 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
468 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
469 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
472 $bug_affected{$ref}=1;
474 if (@{$data->{fixed_versions}}) {
475 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
477 if (!length($data->{done})) {
478 &transcript("$gBug is already open, cannot reopen.\n\n");
482 $noriginator eq '' ? "$gBug reopened, originator not changed." :
483 "$gBug reopened, originator set to $noriginator.";
485 &addmaintainers($data);
486 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
487 $data->{fixed_versions}= [];
489 } while (&getnextbug);
492 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
497 if (!length($data->{done}) and not defined($version)) {
498 &transcript("$gBug is already open, cannot reopen.\n\n");
503 "$gBug marked as found in version $version." :
506 &addmaintainers($data);
507 # The 'done' field gets a bit weird with version
508 # tracking, because a bug may be closed by multiple
509 # people in different branches. Until we have something
510 # more flexible, we set it every time a bug is fixed,
511 # and clear it precisely when a found command is
512 # received for the rightmost fixed-in version, which
513 # equates to the most recent fixing of the bug, or when
514 # a versionless found command is received.
515 if (defined $version) {
516 my $lastfixed = $data->{fixed_versions}[-1];
517 # TODO: what if $data->{package} is a source package?
518 addfoundversions($data, $data->{package}, $version, 'binary');
519 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
523 # Versionless found; assume old-style "not fixed at
525 $data->{fixed_versions} = [];
528 } while (&getnextbug);
531 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
536 $action= "$gBug marked as not found in version $version.";
537 if (length($data->{done})) {
538 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
541 &addmaintainers($data);
542 removefoundversions($data, $data->{package}, $version, 'binary');
543 } while (&getnextbug);
545 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
546 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
549 $bug_affected{$ref}=1;
550 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
551 $ref = $clonebugs{$ref};
554 if (&checkpkglimit) {
556 &addmaintainers($data);
557 $oldsubmitter= $data->{originator};
558 $data->{originator}= $newsubmitter;
559 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
561 &transcript("$action\n");
562 if (length($data->{done})) {
563 &transcript("(By the way, that $gBug is currently marked as done.)\n");
567 From: $gMaintainerEmail ($gProject $gBug Tracking System)
569 Subject: $gBug#$ref submitter address changed
571 References: $header{'message-id'} $data->{msgid}
572 In-Reply-To: $data->{msgid}
573 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
574 Reply-To: $ref\@$gEmailDomain
575 X-$gProject-PR-Message: submitter-changed $ref
577 The submitter address recorded for your $gBug report
578 #$ref: $data->{subject}
581 The old submitter address for this report was
583 The new submitter address is
586 This change was made by
588 If it was incorrect, please contact them directly.
591 (administrator, $gProject $gBugs database)
594 &sendmailmessage($message,$oldsubmitter);
601 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
603 $ref= $1; $whereto= $2;
604 $bug_affected{$ref}=1;
606 if (length($data->{forwarded})) {
607 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
609 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
611 if (length($data->{done})) {
612 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
615 &addmaintainers($data);
616 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
617 &addccaddress("$gForwardList\@$gListDomain");
619 $data->{forwarded}= $whereto;
620 } while (&getnextbug);
622 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
625 $bug_affected{$ref}=1;
627 if (!length($data->{forwarded})) {
628 &transcript("$gBug is not marked as having been forwarded.\n\n");
631 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
633 &addmaintainers($data);
634 $data->{forwarded}= '';
635 } while (&getnextbug);
638 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
639 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
642 $bug_affected{$ref}=1;
644 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
645 &transcript("Severity level \`$newseverity' is not known.\n".
646 "Recognized are: $gShowSeverities.\n\n");
647 } elsif (exists $gObsoleteSeverities{$newseverity}) {
648 &transcript("Severity level \`$newseverity' is obsolete. " .
649 "$gObsoleteSeverities{$newseverity}\n\n");
651 $printseverity= $data->{severity};
652 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
653 $action= "Severity set to \`$newseverity' from \`$printseverity'";
655 &addmaintainers($data);
656 if (defined $gStrongList and isstrongseverity($newseverity)) {
657 addbcc("$gStrongList\@$gListDomain");
659 $data->{severity}= $newseverity;
660 } while (&getnextbug);
662 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
664 $ref = $1; $addsubcode = $3; $tags = $4;
665 $bug_affected{$ref}=1;
667 if (defined $addsubcode) {
668 $addsub = "sub" if ($addsubcode eq "-");
669 $addsub = "add" if ($addsubcode eq "+");
670 $addsub = "set" if ($addsubcode eq "=");
674 foreach my $t (split /[\s,]+/, $tags) {
675 if (!grep($_ eq $t, @gTags)) {
682 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
683 "Recognized are: ".join(' ', @gTags).".\n\n");
686 if ($data->{keywords} eq '') {
687 &transcript("There were no tags set.\n");
689 &transcript("Tags were: $data->{keywords}\n");
691 if ($addsub eq "set") {
692 $action= "Tags set to: " . join(", ", @okaytags);
693 } elsif ($addsub eq "add") {
694 $action= "Tags added: " . join(", ", @okaytags);
695 } elsif ($addsub eq "sub") {
696 $action= "Tags removed: " . join(", ", @okaytags);
699 &addmaintainers($data);
700 $data->{keywords} = '' if ($addsub eq "set");
701 # Allow removing obsolete tags.
702 if ($addsub eq "sub") {
703 foreach my $t (@badtags) {
704 $data->{keywords} = join ' ', grep $_ ne $t,
705 split ' ', $data->{keywords};
708 # Now process all other additions and subtractions.
709 foreach my $t (@okaytags) {
710 $data->{keywords} = join ' ', grep $_ ne $t,
711 split ' ', $data->{keywords};
712 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
714 $data->{keywords} =~ s/\s*$//;
715 } while (&getnextbug);
717 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
719 my $bugnum = $2; my $blockers = $4;
721 $addsub = "sub" if ($1 eq "un");
722 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
723 $bugnum = $clonebugs{$bugnum};
728 foreach my $b (split /[\s,]+/, $blockers) {
732 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
733 $ref = $clonebugs{$ref};
736 push @okayblockers, $b;
738 # add to the list all bugs that are merged with $b,
739 # because all of their data must be kept in sync
740 @thisbugmergelist= split(/ /,$data->{mergedwith});
743 foreach $ref (@thisbugmergelist) {
745 push @okayblockers, $ref;
752 push @badblockers, $b;
756 push @badblockers, $b;
760 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
765 if ($data->{blockedby} eq '') {
766 &transcript("Was not blocked by any bugs.\n");
768 &transcript("Was blocked by: $data->{blockedby}\n");
770 if ($addsub eq "set") {
771 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
772 } elsif ($addsub eq "add") {
773 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
774 } elsif ($addsub eq "sub") {
775 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
780 &addmaintainers($data);
781 my @oldblockerlist = split ' ', $data->{blockedby};
782 $data->{blockedby} = '' if ($addsub eq "set");
783 foreach my $b (@okayblockers) {
784 $data->{blockedby} = manipset($data->{blockedby}, $b,
788 foreach my $b (@oldblockerlist) {
789 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
790 push @{$removedblocks{$b}}, $ref;
793 foreach my $b (split ' ', $data->{blockedby}) {
794 if (! grep { $_ eq $b } @oldblockerlist) {
795 push @{$addedblocks{$b}}, $ref;
798 } while (&getnextbug);
800 # Now that the blockedby data is updated, change blocks data
801 # to match the changes.
802 foreach $ref (keys %addedblocks) {
804 foreach my $b (@{$addedblocks{$ref}}) {
805 $data->{blocks} = manipset($data->{blocks}, $b, 1);
810 foreach $ref (keys %removedblocks) {
812 foreach my $b (@{$removedblocks{$ref}}) {
813 $data->{blocks} = manipset($data->{blocks}, $b, 0);
819 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
821 $ref= $1; $newtitle= $2;
822 $bug_affected{$ref}=1;
823 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
824 $ref = $clonebugs{$ref};
827 if (&checkpkglimit) {
829 &addmaintainers($data);
830 $data->{subject}= $newtitle;
831 $action= "Changed $gBug title.";
833 &transcript("$action\n");
834 if (length($data->{done})) {
835 &transcript("(By the way, that $gBug is currently marked as done.)\n");
844 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
847 $bug_affected{$ref} = 1;
849 if (!length($data->{mergedwith})) {
850 &transcript("$gBug is not marked as being merged with any others.\n\n");
853 $mergelowstate eq 'locked' || die "$mergelowstate ?";
854 $action= "Disconnected #$ref from all other report(s).";
855 @newmergelist= split(/ /,$data->{mergedwith});
857 @bug_affected{@newmergelist} = 1 x @newmergelist;
859 &addmaintainers($data);
860 $data->{mergedwith}= ($ref == $discref) ? ''
861 : join(' ',grep($_ ne $ref,@newmergelist));
862 } while (&getnextbug);
865 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
867 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
868 my @newmergelist= ();
873 while (defined($ref= shift(@tomerge))) {
874 &transcript("D| checking merge $ref\n") if $dl;
876 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
877 $ref = $clonebugs{$ref};
879 next if grep($_ == $ref,@newmergelist);
880 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
881 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
883 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
885 &checkmatch('package','m_package',$data->{package},@newmergelist);
886 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
887 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
888 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
889 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
890 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
891 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
892 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
893 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
894 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
895 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
896 if (length($mismatch)) {
897 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
899 &cancelbug; @newmergelist=(); last;
901 push(@newmergelist,$ref);
902 push(@tomerge,split(/ /,$data->{mergedwith}));
906 @newmergelist= sort { $a <=> $b } @newmergelist;
907 $action= "Merged @newmergelist.";
908 delete @fixed{keys %found};
909 for $ref (@newmergelist) {
910 &getbug || die "huh ? $gBug $ref disappeared during merge";
911 &addmaintainers($data);
912 @bug_affected{@newmergelist} = 1 x @newmergelist;
913 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
914 $data->{keywords}= join(' ', keys %tags);
915 $data->{found_versions}= [sort keys %found];
916 $data->{fixed_versions}= [sort keys %fixed];
919 &transcript("$action\n\n");
922 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
924 my @temp = split /\s+\#?/,$1;
925 my $master_bug = shift @temp;
927 my @tomerge = sort { $a <=> $b } @temp;
928 unshift @tomerge,$master_bug;
929 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
930 my @newmergelist= ();
934 # Here we try to do the right thing.
935 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
936 # If not, we discard the found and fixed.
937 # Everything else we set to the values of the first bug.
939 while (defined($ref= shift(@tomerge))) {
940 &transcript("D| checking merge $ref\n") if $dl;
942 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
943 $ref = $clonebugs{$ref};
945 next if grep($_ == $ref,@newmergelist);
946 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
947 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
949 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
950 $master_bug_data = $data if not defined $master_bug_data;
951 if ($data->{package} ne $master_bug_data->{package}) {
952 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
953 "$gBug $ref is not in the same package as $master_bug\n");
954 &cancelbug; @newmergelist=(); last;
956 for my $t (split /\s+/,$data->{keywords}) {
959 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
960 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
961 push(@newmergelist,$ref);
962 push(@tomerge,split(/ /,$data->{mergedwith}));
966 @newmergelist= sort { $a <=> $b } @newmergelist;
967 $action= "Forcibly Merged @newmergelist.";
968 delete @fixed{keys %found};
969 for $ref (@newmergelist) {
970 &getbug || die "huh ? $gBug $ref disappeared during merge";
971 &addmaintainers($data);
972 @bug_affected{@newmergelist} = 1 x @newmergelist;
973 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
974 $data->{keywords}= join(' ', keys %tags);
975 $data->{found_versions}= [sort keys %found];
976 $data->{fixed_versions}= [sort keys %fixed];
977 my @field_list = qw(forwarded package severity blocks blockedby owner done);
978 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
981 &transcript("$action\n\n");
984 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
988 @newclonedids = split /\s+/, $2;
989 $newbugsneeded = scalar(@newclonedids);
992 $bug_affected{$ref} = 1;
994 if (length($data->{mergedwith})) {
995 &transcript("$gBug is marked as being merged with others.\n\n");
998 &filelock("nextnumber.lock");
999 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1000 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1001 $firstref= $v+0; $v += $newbugsneeded;
1002 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1005 $lastref = $firstref + $newbugsneeded - 1;
1007 if ($newbugsneeded == 1) {
1008 $action= "$gBug $origref cloned as bug $firstref.";
1010 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1013 my $blocks = $data->{blocks};
1014 my $blockedby = $data->{blockedby};
1017 my $ohash = get_hashname($origref);
1018 my $clone = $firstref;
1019 @bug_affected{@newclonedids} = 1 x @newclonedids;
1020 for $newclonedid (@newclonedids) {
1021 $clonebugs{$newclonedid} = $clone;
1023 my $hash = get_hashname($clone);
1024 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1025 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1026 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1027 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1028 &bughook('new', $clone, $data);
1030 # Update blocking info of bugs blocked by or blocking the
1032 foreach $ref (split ' ', $blocks) {
1034 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1037 foreach $ref (split ' ', $blockedby) {
1039 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1047 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
1049 my @pkgs = split /\s+/, $1;
1050 if (scalar(@pkgs) > 0) {
1051 %limit_pkgs = map { ($_, 1) } @pkgs;
1052 &transcript("Ignoring bugs not assigned to: " .
1053 join(" ", keys(%limit_pkgs)) . "\n\n");
1056 &transcript("Not ignoring any bugs.\n\n");
1058 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1059 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1062 $bug_affected{$ref} = 1;
1064 if (length $data->{owner}) {
1065 $action = "Owner changed from $data->{owner} to $newowner.";
1067 $action = "Owner recorded as $newowner.";
1069 if (length $data->{done}) {
1070 $extramessage = "(By the way, this $gBug is currently " .
1071 "marked as done.)\n";
1074 &addmaintainers($data);
1075 $data->{owner} = $newowner;
1076 } while (&getnextbug);
1078 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1081 $bug_affected{$ref} = 1;
1083 if (length $data->{owner}) {
1084 $action = "Removed annotation that $gBug was owned by " .
1087 &addmaintainers($data);
1088 $data->{owner} = '';
1089 } while (&getnextbug);
1091 &transcript("$gBug is not marked as having an owner.\n\n");
1096 &transcript("Unknown command or malformed arguments to command.\n\n");
1097 if (++$unknowns >= 5) {
1098 &transcript("Too many unknown commands, stopping here.\n\n");
1103 if ($procline>$#bodylines) {
1104 &transcript(">\nEnd of message, stopping processing here.\n\n");
1106 if (!$ok && !quickabort) {
1107 &transcript("No commands successfully parsed; sending the help text(s).\n");
1112 &transcript("MC\n") if $dl>1;
1114 for $maint (keys %maintccreasons) {
1115 &transcript("MM|$maint|\n") if $dl>1;
1116 next if $maint eq $replyto;
1118 $reasonsref= $maintccreasons{$maint};
1119 &transcript("MY|$maint|\n") if $dl>2;
1120 for $p (sort keys %$reasonsref) {
1121 &transcript("MP|$p|\n") if $dl>2;
1122 $reasonstring.= ', ' if length($reasonstring);
1123 $reasonstring.= $p.' ' if length($p);
1124 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1126 if (length($reasonstring) > 40) {
1127 (substr $reasonstring, 37) = "...";
1129 $reasonstring = "" if (!defined($reasonstring));
1130 push(@maintccs,"$maint ($reasonstring)");
1131 push(@maintccaddrs,"$maint");
1136 &transcript("MC|@maintccs|\n") if $dl>2;
1137 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1140 # Add Bcc's to subscribed bugs
1141 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1143 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1144 $header{'subject'} = "your mail";
1148 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1150 ${maintccs}Subject: Processed: $header{'subject'}
1151 In-Reply-To: $header{'message-id'}
1152 References: $header{'message-id'}
1153 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1155 X-$gProject-PR-Message: transcript
1157 ${transcript}Please contact me if you need assistance.
1160 (administrator, $gProject $gBugs database)
1164 $repliedshow= join(', ',$replyto,@maintccaddrs);
1165 &filelock("lock/-1");
1166 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1168 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1170 "<strong>Request received</strong> from <code>".
1171 &sani($header{'from'})."</code>\n".
1172 "to <code>".&sani($controlrequestaddr)."</code>\n".
1174 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1175 close(AP) || &quit("open db-h/-1.log: $!");
1177 utime(time,time,"db-h");
1179 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1181 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1183 sub sendmailmessage {
1184 local ($message,@recips) = @_;
1185 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1186 send_mail_message(message => $message,
1187 recipients => \@recips,
1193 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1194 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1198 #sub unimplemented {
1199 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1203 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1205 if (@newmergelist) {
1206 eval "\$mvarvalue= \$$mvarname";
1207 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1210 "Values for \`$string' don't match:\n".
1211 " #$newmergelist[0] has \`$mvarvalue';\n".
1212 " #$ref has \`$svarvalue'\n"
1213 if $mvarvalue ne $svarvalue;
1215 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1217 eval "\$$mvarname= \$svarvalue";
1222 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1223 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1234 my %h = map { $_ => 1 } split ' ', $list;
1241 return join ' ', sort keys %h;
1244 # High-level bug manipulation calls
1245 # Do announcements themselves
1247 # Possible calling sequences:
1248 # setbug (returns 0)
1250 # setbug (returns 1)
1251 # &transcript(something)
1254 # setbug (returns 1)
1255 # $action= (something)
1257 # (modify s_* variables)
1258 # } while (getnextbug);
1261 &dlen("nochangebug");
1262 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1264 &endmerge if $manybugs;
1266 &dlex("nochangebug");
1270 &dlen("setbug $ref");
1271 if ($ref =~ m/^-\d+/) {
1272 if (!defined $clonebugs{$ref}) {
1274 &dlex("setbug => noclone");
1277 $ref = $clonebugs{$ref};
1279 $state eq 'idle' || die "$state ?";
1282 &dlex("setbug => 0s");
1286 if (!&checkpkglimit) {
1291 @thisbugmergelist= split(/ /,$data->{mergedwith});
1292 if (!@thisbugmergelist) {
1297 &dlex("setbug => 1s");
1306 &dlex("setbug => 0mc");
1310 $state= 'multiple'; $sref=$ref;
1311 &dlex("setbug => 1m");
1316 &dlen("getnextbug");
1317 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1319 if (!$manybugs || !@thisbugmergelist) {
1320 length($action) || die;
1321 &transcript("$action\n$extramessage\n");
1322 &endmerge if $manybugs;
1324 &dlex("getnextbug => 0");
1327 $ref= shift(@thisbugmergelist);
1328 &getbug || die "bug $ref disappeared";
1330 &dlex("getnextbug => 1");
1334 # Low-level bug-manipulation calls
1335 # Do no announcements
1337 # getbug (returns 0)
1339 # getbug (returns 1)
1343 # $action= (something)
1344 # getbug (returns 1)
1346 # getbug (returns 1)
1348 # [getbug (returns 0)]
1349 # &transcript("$action\n\n")
1352 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1353 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1357 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1358 &filelock('lock/merge');
1359 $mergelowstate='locked';
1365 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1367 $mergelowstate='idle';
1372 &dlen("getbug $ref");
1373 $lowstate eq 'idle' || die "$state ?";
1374 if (($data = &lockreadbug($ref))) {
1377 &dlex("getbug => 1");
1382 &dlex("getbug => 0");
1388 $lowstate eq 'open' || die "$state ?";
1395 &dlen("savebug $ref");
1396 $lowstate eq 'open' || die "$lowstate ?";
1397 length($action) || die;
1398 $ref == $sref || die "read $sref but saving $ref ?";
1399 my $hash = get_hashname($ref);
1400 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1403 "<strong>".&sani($action)."</strong>\n".
1404 "Request was from <code>".&sani($header{'from'})."</code>\n".
1405 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1407 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1408 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1409 unlockwritebug($ref, $data);
1416 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1421 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1425 print $_[0] if $debug;
1426 $transcript.= $_[0];
1433 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1434 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1450 sub sendtxthelpraw {
1451 local ($relpath,$description) = @_;
1453 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1454 while(<D>) { $doc.=$_; }
1456 &transcript("Sending $description in separate message.\n");
1457 &sendmailmessage(<<END.$doc,$replyto);
1458 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1460 Subject: $gProject $gBug help: $description
1461 References: $header{'message-id'}
1462 In-Reply-To: $header{'message-id'}
1463 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1465 X-$gProject-PR-Message: doc-text $relpath
1471 sub sendlynxdocraw {
1472 local ($relpath,$description) = @_;
1474 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1475 while(<L>) { $doc.=$_; }
1477 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1478 &transcript("Information ($description) is not available -\n".
1479 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1482 &transcript("Error getting $description (code $? $!):\n$doc\n");
1484 &transcript("Sending $description.\n");
1485 &sendmailmessage(<<END.$doc,$replyto);
1486 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1488 Subject: $gProject $gBugs information: $description
1489 References: $header{'message-id'}
1490 In-Reply-To: $header{'message-id'}
1491 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1493 X-$gProject-PR-Message: doc-html $relpath
1502 $maintccreasons{$cca}{''}{$ref}= 1;
1505 sub addmaintainers {
1506 # Data structure is:
1507 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1510 &ensuremaintainersloaded;
1511 $anymaintfound=0; $anymaintnotfound=0;
1512 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1514 $p =~ /([a-z0-9.+-]+)/;
1516 next unless defined $p;
1517 if (defined $gSubscriptionDomain) {
1518 if (defined($pkgsrc{$p})) {
1519 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1521 addbcc("$p\@$gSubscriptionDomain");
1524 if (defined $data->{severity} and defined $gStrongList and
1525 isstrongseverity($data->{severity})) {
1526 addbcc("$gStrongList\@$gListDomain");
1528 if (defined($maintainerof{$p})) {
1529 $addmaint= $maintainerof{$p};
1530 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1531 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1532 print "maintainer add >$p|$addmaint<\n" if $debug;
1534 print "maintainer none >$p<\n" if $debug;
1535 &transcript("Warning: Unknown package '$p'\n");
1536 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1537 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1541 if (length $data->{owner}) {
1542 $addmaint = $data->{owner};
1543 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1544 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1545 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1549 sub ensuremaintainersloaded {
1551 return if $maintainersloaded++;
1552 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1556 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1557 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1558 $maintainerof{$a}= $2;
1561 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1565 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1566 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1567 $maintainerof{$a}= $2;
1570 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1572 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1573 my ($a, $b) = ($1, $2);
1574 $pkgsrc{lc($a)} = $b;
1580 local ($wherefrom,$path,$description) = @_;
1581 if ($wherefrom eq "ftp.d.o") {
1582 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1584 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1585 &transcript("$description is not available.\n");
1588 &transcript("Error getting $description (code $? $!):\n$doc\n");
1591 } elsif ($wherefrom eq "local") {
1593 $doc = do { local $/; <P> };
1596 &transcript("internal errror: info files location unknown.\n");
1599 &transcript("Sending $description.\n");
1600 &sendmailmessage(<<END.$doc,$replyto);
1601 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1603 Subject: $gProject $gBugs information: $description
1604 References: $header{'message-id'}
1605 In-Reply-To: $header{'message-id'}
1606 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1608 X-$gProject-PR-Message: getinfo
1610 $description follows: