2 # $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
9 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
10 use Debbugs::Mail qw(send_mail_message);
12 use HTML::Entities qw(encode_entities);
14 use Debbugs::Config qw(:globals);
15 use Debbugs::CGI qw(html_escape);
16 $lib_path = $gLibPath;
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 # This is an error counter which should be incremented every time there is an error.
126 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
128 &transcript("Processing commands for $controlrequestaddr:\n\n");
133 $mergelowstate= 'idle';
139 $user =~ s/^.*<(.*)>.*$/$1/;
140 $user =~ s/[(].*[)]//;
141 $user =~ s/^\s*(\S+)\s+.*$/$1/;
142 $user = "" unless (Debbugs::User::is_valid_user($user));
146 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
147 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
148 &transcript("This service is unavailable.\n\n");
157 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
160 for ($procline=0; $procline<=$#bodylines; $procline++) {
161 $state eq 'idle' || print "$state ?\n";
162 $lowstate eq 'idle' || print "$lowstate ?\n";
163 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
165 &transcript("Stopping processing here.\n\n");
168 $_= $bodylines[$procline]; s/\s+$//;
170 &transcript("> $_\n");
173 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
174 &transcript("Stopping processing here.\n\n");
176 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
178 &transcript("Debug level $dl.\n\n");
179 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
181 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
182 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
184 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
185 "detailed logs for $gBug#$ref");
186 } elsif (m/^index(\s+full)?$/i) {
187 &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-package$/i) {
191 &transcript("This BTS function is currently disabled, sorry.\n\n");
193 $ok++; # well, it's not really ok, but it fixes #81224 :)
194 } elsif (m/^index-summary(\s+by-number)?$/i) {
195 &transcript("This BTS function is currently disabled, sorry.\n\n");
197 $ok++; # well, it's not really ok, but it fixes #81224 :)
198 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
199 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
200 } elsif (m/^index(\s+|-)maints?$/i) {
201 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
202 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
204 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
205 "$gBug list for maintainer \`$maint'");
207 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
209 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
210 "$gBug list for package $package");
212 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
213 &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/^send-unmatched\s+(last|-1)$/i) {
217 &transcript("This BTS function is currently disabled, sorry.\n\n");
219 $ok++; # well, it's not really ok, but it fixes #81224 :)
220 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
221 &transcript("This BTS function is currently disabled, sorry.\n\n");
223 $ok++; # well, it's not really ok, but it fixes #81224 :)
224 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
225 # the following is basically a Debian-specific kludge, but who cares
227 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
228 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
229 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
231 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
232 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
233 &sendinfo("local", "$gConfigDir/$req", "$req file");
235 &transcript("Info file $req does not exist.\n\n");
237 } elsif (m/^help/i) {
241 } elsif (m/^refcard/i) {
242 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
243 } elsif (m/^subscribe/i) {
245 There is no $gProject $gBug mailing list. If you wish to review bug reports
246 please do so via http://$gWebDomain/ or ask this mail server
248 soon: MAILINGLISTS_TEXT
250 } elsif (m/^unsubscribe/i) {
252 soon: UNSUBSCRIBE_TEXT
253 soon: MAILINGLISTS_TEXT
255 } elsif (m/^user\s+(\S+)\s*$/i) {
257 if (Debbugs::User::is_valid_user($newuser)) {
258 my $olduser = ($user ne "" ? " (was $user)" : "");
259 &transcript("Setting user to $newuser$olduser.\n");
262 &transcript("Selected user id ($newuser) invalid, sorry\n");
266 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
269 my $hidden = ($2 ne "");
275 while (++$procline <= $#bodylines) {
276 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
280 &transcript("> $bodylines[$procline]\n");
282 my ($o, $txt) = ($1, $2);
283 if ($#cats == -1 && $o eq "+") {
284 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
290 unless (ref($cats[-1]) eq "HASH") {
291 $cats[-1] = { "nam" => $cats[-1],
292 "pri" => [], "ttl" => [] };
295 my ($desc, $ord, $op);
296 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
297 $desc = $1; $ord = $3; $op = "";
298 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
299 $desc = $1; $ord = $3; $op = $4;
300 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
301 $desc = ""; $op = $1;
303 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
308 $ord = 999 unless defined $ord;
311 push @{$cats[-1]->{"pri"}}, $prefix . $op;
312 push @{$cats[-1]->{"ttl"}}, $desc;
313 push @ords, "$ord $catsec";
315 @cats[-1]->{"def"} = $desc;
316 push @ords, "$ord DEF";
319 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
320 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
321 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
322 } elsif ($o eq "*") {
325 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
326 $name = $1; $prefix = $3;
328 $name = $txt; $prefix = "";
333 # XXX: got @cats, now do something with it
334 my $u = Debbugs::User::get_user($user);
336 &transcript("Added usercategory $catname.\n\n");
337 $u->{"categories"}->{$catname} = [ @cats ];
339 &transcript("Removed usercategory $catname.\n\n");
340 delete $u->{"categories"}->{$catname};
343 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
345 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
347 &transcript("No valid user selected\n");
352 Debbugs::User::read_usertags(\%ut, $user);
353 my @oldtags = (); my @newtags = (); my @badtags = ();
355 for my $t (split /[,\s]+/, $tags) {
356 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
363 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
366 for my $t (keys %chtags) {
367 $ut{$t} = [] unless defined $ut{$t};
369 for my $t (keys %ut) {
370 my %res = map { ($_, 1) } @{$ut{$t}};
371 push @oldtags, $t if defined $res{$ref};
372 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
373 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
374 : $addsubcode eq "=");
375 $res{$ref} = 1 if ($addop && defined $chtags{$t});
376 delete $res{$ref} if ($del);
377 push @newtags, $t if defined $res{$ref};
378 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
381 &transcript("There were no usertags set.\n");
383 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
385 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
386 Debbugs::User::write_usertags(\%ut, $user);
388 } elsif (!$control) {
390 Unknown command or malformed arguments to command.
391 (Use control\@$gEmailDomain to manipulate reports.)
395 if (++$unknowns >= 3) {
396 &transcript("Too many unknown commands, stopping here.\n\n");
399 #### "developer only" ones start here
400 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
403 $bug_affected{$ref}=1;
406 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
407 if (length($data->{done}) and not defined($version)) {
408 &transcript("$gBug is already closed, cannot re-close.\n\n");
413 "marked as fixed in version $version" :
415 ", send any further explanations to $data->{originator}";
417 &addmaintainers($data);
418 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
419 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
420 $data->{done}= $replyto;
421 my @keywords= split ' ', $data->{keywords};
422 if (grep $_ eq 'pending', @keywords) {
423 $extramessage= "Removed pending tag.\n";
424 $data->{keywords}= join ' ', grep $_ ne 'pending',
427 addfixedversions($data, $data->{package}, $version, 'binary');
430 From: $gMaintainerEmail ($gProject $gBug Tracking System)
431 To: $data->{originator}
432 Subject: $gBug#$ref acknowledged by developer
434 References: $header{'message-id'} $data->{msgid}
435 In-Reply-To: $data->{msgid}
436 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
437 Reply-To: $ref\@$gEmailDomain
438 X-$gProject-PR-Message: they-closed-control $ref
440 This is an automatic notification regarding your $gBug report
441 #$ref: $data->{subject},
442 which was filed against the $data->{package} package.
444 It has been marked as closed by one of the developers, namely
447 You should be hearing from them with a substantive response shortly,
448 in case you haven't already. If not, please contact them directly.
451 (administrator, $gProject $gBugs database)
454 &sendmailmessage($message,$data->{originator});
455 } while (&getnextbug);
458 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
460 $ref= $1; $newpackage= $2;
461 $bug_affected{$ref}=1;
463 $newpackage =~ y/A-Z/a-z/;
465 if (length($data->{package})) {
466 $action= "$gBug reassigned from package \`$data->{package}'".
467 " to \`$newpackage'.";
469 $action= "$gBug assigned to package \`$newpackage'.";
472 &addmaintainers($data);
473 $data->{package}= $newpackage;
474 $data->{found_versions}= [];
475 $data->{fixed_versions}= [];
476 # TODO: what if $newpackage is a source package?
477 addfoundversions($data, $data->{package}, $version, 'binary');
478 &addmaintainers($data);
479 } while (&getnextbug);
481 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
482 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
483 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
484 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
487 $bug_affected{$ref}=1;
489 if (@{$data->{fixed_versions}}) {
490 &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");
492 if (!length($data->{done})) {
493 &transcript("$gBug is already open, cannot reopen.\n\n");
497 $noriginator eq '' ? "$gBug reopened, originator not changed." :
498 "$gBug reopened, originator set to $noriginator.";
500 &addmaintainers($data);
501 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
502 $data->{fixed_versions}= [];
504 } while (&getnextbug);
507 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
512 if (!length($data->{done}) and not defined($version)) {
513 &transcript("$gBug is already open, cannot reopen.\n\n");
519 "$gBug marked as found in version $version." :
522 &addmaintainers($data);
523 # The 'done' field gets a bit weird with version
524 # tracking, because a bug may be closed by multiple
525 # people in different branches. Until we have something
526 # more flexible, we set it every time a bug is fixed,
527 # and clear it precisely when a found command is
528 # received for the rightmost fixed-in version, which
529 # equates to the most recent fixing of the bug, or when
530 # a versionless found command is received.
531 if (defined $version) {
532 my $lastfixed = $data->{fixed_versions}[-1];
533 # TODO: what if $data->{package} is a source package?
534 addfoundversions($data, $data->{package}, $version, 'binary');
535 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
539 # Versionless found; assume old-style "not fixed at
541 $data->{fixed_versions} = [];
544 } while (&getnextbug);
547 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
552 $action= "$gBug marked as not found in version $version.";
553 if (length($data->{done})) {
554 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
557 &addmaintainers($data);
558 removefoundversions($data, $data->{package}, $version, 'binary');
559 } while (&getnextbug);
561 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
562 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
565 $bug_affected{$ref}=1;
566 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
567 $ref = $clonebugs{$ref};
570 if (&checkpkglimit) {
572 &addmaintainers($data);
573 $oldsubmitter= $data->{originator};
574 $data->{originator}= $newsubmitter;
575 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
577 &transcript("$action\n");
578 if (length($data->{done})) {
579 &transcript("(By the way, that $gBug is currently marked as done.)\n");
583 From: $gMaintainerEmail ($gProject $gBug Tracking System)
585 Subject: $gBug#$ref submitter address changed
587 References: $header{'message-id'} $data->{msgid}
588 In-Reply-To: $data->{msgid}
589 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
590 Reply-To: $ref\@$gEmailDomain
591 X-$gProject-PR-Message: submitter-changed $ref
593 The submitter address recorded for your $gBug report
594 #$ref: $data->{subject}
597 The old submitter address for this report was
599 The new submitter address is
602 This change was made by
604 If it was incorrect, please contact them directly.
607 (administrator, $gProject $gBugs database)
610 &sendmailmessage($message,$oldsubmitter);
617 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
619 $ref= $1; $whereto= $2;
620 $bug_affected{$ref}=1;
622 if (length($data->{forwarded})) {
623 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
625 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
627 if (length($data->{done})) {
628 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
631 &addmaintainers($data);
632 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
633 &addccaddress("$gForwardList\@$gListDomain");
635 $data->{forwarded}= $whereto;
636 } while (&getnextbug);
638 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
641 $bug_affected{$ref}=1;
643 if (!length($data->{forwarded})) {
644 &transcript("$gBug is not marked as having been forwarded.\n\n");
647 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
649 &addmaintainers($data);
650 $data->{forwarded}= '';
651 } while (&getnextbug);
654 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
655 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
658 $bug_affected{$ref}=1;
660 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
661 &transcript("Severity level \`$newseverity' is not known.\n".
662 "Recognized are: $gShowSeverities.\n\n");
664 } elsif (exists $gObsoleteSeverities{$newseverity}) {
665 &transcript("Severity level \`$newseverity' is obsolete. " .
666 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
669 $printseverity= $data->{severity};
670 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
671 $action= "Severity set to \`$newseverity' from \`$printseverity'";
673 &addmaintainers($data);
674 if (defined $gStrongList and isstrongseverity($newseverity)) {
675 addbcc("$gStrongList\@$gListDomain");
677 $data->{severity}= $newseverity;
678 } while (&getnextbug);
680 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
682 $ref = $1; $addsubcode = $3; $tags = $4;
683 $bug_affected{$ref}=1;
685 if (defined $addsubcode) {
686 $addsub = "sub" if ($addsubcode eq "-");
687 $addsub = "add" if ($addsubcode eq "+");
688 $addsub = "set" if ($addsubcode eq "=");
692 foreach my $t (split /[\s,]+/, $tags) {
693 if (!grep($_ eq $t, @gTags)) {
700 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
701 "Recognized are: ".join(' ', @gTags).".\n\n");
705 if ($data->{keywords} eq '') {
706 &transcript("There were no tags set.\n");
708 &transcript("Tags were: $data->{keywords}\n");
710 if ($addsub eq "set") {
711 $action= "Tags set to: " . join(", ", @okaytags);
712 } elsif ($addsub eq "add") {
713 $action= "Tags added: " . join(", ", @okaytags);
714 } elsif ($addsub eq "sub") {
715 $action= "Tags removed: " . join(", ", @okaytags);
718 &addmaintainers($data);
719 $data->{keywords} = '' if ($addsub eq "set");
720 # Allow removing obsolete tags.
721 if ($addsub eq "sub") {
722 foreach my $t (@badtags) {
723 $data->{keywords} = join ' ', grep $_ ne $t,
724 split ' ', $data->{keywords};
727 # Now process all other additions and subtractions.
728 foreach my $t (@okaytags) {
729 $data->{keywords} = join ' ', grep $_ ne $t,
730 split ' ', $data->{keywords};
731 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
733 $data->{keywords} =~ s/\s*$//;
734 } while (&getnextbug);
736 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
738 my $bugnum = $2; my $blockers = $4;
740 $addsub = "sub" if ($1 eq "un");
741 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
742 $bugnum = $clonebugs{$bugnum};
747 foreach my $b (split /[\s,]+/, $blockers) {
751 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
752 $ref = $clonebugs{$ref};
756 push @okayblockers, $ref;
758 # add to the list all bugs that are merged with $b,
759 # because all of their data must be kept in sync
760 @thisbugmergelist= split(/ /,$data->{mergedwith});
763 foreach $ref (@thisbugmergelist) {
765 push @okayblockers, $ref;
772 push @badblockers, $ref;
776 push @badblockers, $b;
780 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
786 if ($data->{blockedby} eq '') {
787 &transcript("Was not blocked by any bugs.\n");
789 &transcript("Was blocked by: $data->{blockedby}\n");
791 if ($addsub eq "set") {
792 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
793 } elsif ($addsub eq "add") {
794 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
795 } elsif ($addsub eq "sub") {
796 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
801 &addmaintainers($data);
802 my @oldblockerlist = split ' ', $data->{blockedby};
803 $data->{blockedby} = '' if ($addsub eq "set");
804 foreach my $b (@okayblockers) {
805 $data->{blockedby} = manipset($data->{blockedby}, $b,
809 foreach my $b (@oldblockerlist) {
810 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
811 push @{$removedblocks{$b}}, $ref;
814 foreach my $b (split ' ', $data->{blockedby}) {
815 if (! grep { $_ eq $b } @oldblockerlist) {
816 push @{$addedblocks{$b}}, $ref;
819 } while (&getnextbug);
821 # Now that the blockedby data is updated, change blocks data
822 # to match the changes.
823 foreach $ref (keys %addedblocks) {
825 foreach my $b (@{$addedblocks{$ref}}) {
826 $data->{blocks} = manipset($data->{blocks}, $b, 1);
831 foreach $ref (keys %removedblocks) {
833 foreach my $b (@{$removedblocks{$ref}}) {
834 $data->{blocks} = manipset($data->{blocks}, $b, 0);
840 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
842 $ref= $1; $newtitle= $2;
843 $bug_affected{$ref}=1;
844 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
845 $ref = $clonebugs{$ref};
848 if (&checkpkglimit) {
850 &addmaintainers($data);
851 my $oldtitle = $data->{subject};
852 $data->{subject}= $newtitle;
853 $action= "Changed $gBug title to ".html_escape($newtitle)." from ".
854 html_escape($oldtitle).".";
856 &transcript("$action\n");
857 if (length($data->{done})) {
858 &transcript("(By the way, that $gBug is currently marked as done.)\n");
867 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
870 $bug_affected{$ref} = 1;
872 if (!length($data->{mergedwith})) {
873 &transcript("$gBug is not marked as being merged with any others.\n\n");
876 $mergelowstate eq 'locked' || die "$mergelowstate ?";
877 $action= "Disconnected #$ref from all other report(s).";
878 @newmergelist= split(/ /,$data->{mergedwith});
880 @bug_affected{@newmergelist} = 1 x @newmergelist;
882 &addmaintainers($data);
883 $data->{mergedwith}= ($ref == $discref) ? ''
884 : join(' ',grep($_ ne $ref,@newmergelist));
885 } while (&getnextbug);
888 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
890 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
891 my @newmergelist= ();
896 while (defined($ref= shift(@tomerge))) {
897 &transcript("D| checking merge $ref\n") if $dl;
899 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
900 $ref = $clonebugs{$ref};
902 next if grep($_ == $ref,@newmergelist);
903 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
904 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
906 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
908 &checkmatch('package','m_package',$data->{package},@newmergelist);
909 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
910 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
911 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
912 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
913 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
914 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
915 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
916 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
917 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
918 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
919 if (length($mismatch)) {
920 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
923 &cancelbug; @newmergelist=(); last;
925 push(@newmergelist,$ref);
926 push(@tomerge,split(/ /,$data->{mergedwith}));
930 @newmergelist= sort { $a <=> $b } @newmergelist;
931 $action= "Merged @newmergelist.";
932 delete @fixed{keys %found};
933 for $ref (@newmergelist) {
934 &getbug || die "huh ? $gBug $ref disappeared during merge";
935 &addmaintainers($data);
936 @bug_affected{@newmergelist} = 1 x @newmergelist;
937 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
938 $data->{keywords}= join(' ', keys %tags);
939 $data->{found_versions}= [sort keys %found];
940 $data->{fixed_versions}= [sort keys %fixed];
943 &transcript("$action\n\n");
946 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
948 my @temp = split /\s+\#?/,$1;
949 my $master_bug = shift @temp;
951 my @tomerge = sort { $a <=> $b } @temp;
952 unshift @tomerge,$master_bug;
953 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
954 my @newmergelist= ();
958 # Here we try to do the right thing.
959 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
960 # If not, we discard the found and fixed.
961 # Everything else we set to the values of the first bug.
963 while (defined($ref= shift(@tomerge))) {
964 &transcript("D| checking merge $ref\n") if $dl;
966 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
967 $ref = $clonebugs{$ref};
969 next if grep($_ == $ref,@newmergelist);
970 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
971 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
973 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
974 $master_bug_data = $data if not defined $master_bug_data;
975 if ($data->{package} ne $master_bug_data->{package}) {
976 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
977 "$gBug $ref is not in the same package as $master_bug\n");
979 &cancelbug; @newmergelist=(); last;
981 for my $t (split /\s+/,$data->{keywords}) {
984 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
985 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
986 push(@newmergelist,$ref);
987 push(@tomerge,split(/ /,$data->{mergedwith}));
991 @newmergelist= sort { $a <=> $b } @newmergelist;
992 $action= "Forcibly Merged @newmergelist.";
993 delete @fixed{keys %found};
994 for $ref (@newmergelist) {
995 &getbug || die "huh ? $gBug $ref disappeared during merge";
996 &addmaintainers($data);
997 @bug_affected{@newmergelist} = 1 x @newmergelist;
998 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
999 $data->{keywords}= join(' ', keys %tags);
1000 $data->{found_versions}= [sort keys %found];
1001 $data->{fixed_versions}= [sort keys %fixed];
1002 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1003 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1006 &transcript("$action\n\n");
1009 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1013 @newclonedids = split /\s+/, $2;
1014 $newbugsneeded = scalar(@newclonedids);
1017 $bug_affected{$ref} = 1;
1019 if (length($data->{mergedwith})) {
1020 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1024 &filelock("nextnumber.lock");
1025 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1026 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1027 $firstref= $v+0; $v += $newbugsneeded;
1028 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1031 $lastref = $firstref + $newbugsneeded - 1;
1033 if ($newbugsneeded == 1) {
1034 $action= "$gBug $origref cloned as bug $firstref.";
1036 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1039 my $blocks = $data->{blocks};
1040 my $blockedby = $data->{blockedby};
1043 my $ohash = get_hashname($origref);
1044 my $clone = $firstref;
1045 @bug_affected{@newclonedids} = 1 x @newclonedids;
1046 for $newclonedid (@newclonedids) {
1047 $clonebugs{$newclonedid} = $clone;
1049 my $hash = get_hashname($clone);
1050 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1051 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1052 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1053 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1054 &bughook('new', $clone, $data);
1056 # Update blocking info of bugs blocked by or blocking the
1058 foreach $ref (split ' ', $blocks) {
1060 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1063 foreach $ref (split ' ', $blockedby) {
1065 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1073 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
1075 my @pkgs = split /\s+/, $1;
1076 if (scalar(@pkgs) > 0) {
1077 %limit_pkgs = map { ($_, 1) } @pkgs;
1078 &transcript("Ignoring bugs not assigned to: " .
1079 join(" ", keys(%limit_pkgs)) . "\n\n");
1082 &transcript("Not ignoring any bugs.\n\n");
1084 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1085 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1088 $bug_affected{$ref} = 1;
1090 if (length $data->{owner}) {
1091 $action = "Owner changed from $data->{owner} to $newowner.";
1093 $action = "Owner recorded as $newowner.";
1095 if (length $data->{done}) {
1096 $extramessage = "(By the way, this $gBug is currently " .
1097 "marked as done.)\n";
1100 &addmaintainers($data);
1101 $data->{owner} = $newowner;
1102 } while (&getnextbug);
1104 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1107 $bug_affected{$ref} = 1;
1109 if (length $data->{owner}) {
1110 $action = "Removed annotation that $gBug was owned by " .
1113 &addmaintainers($data);
1114 $data->{owner} = '';
1115 } while (&getnextbug);
1117 &transcript("$gBug is not marked as having an owner.\n\n");
1122 &transcript("Unknown command or malformed arguments to command.\n\n");
1124 if (++$unknowns >= 5) {
1125 &transcript("Too many unknown commands, stopping here.\n\n");
1130 if ($procline>$#bodylines) {
1131 &transcript(">\nEnd of message, stopping processing here.\n\n");
1133 if (!$ok && !quickabort) {
1135 &transcript("No commands successfully parsed; sending the help text(s).\n");
1140 &transcript("MC\n") if $dl>1;
1142 for $maint (keys %maintccreasons) {
1143 &transcript("MM|$maint|\n") if $dl>1;
1144 next if $maint eq $replyto;
1146 $reasonsref= $maintccreasons{$maint};
1147 &transcript("MY|$maint|\n") if $dl>2;
1148 for $p (sort keys %$reasonsref) {
1149 &transcript("MP|$p|\n") if $dl>2;
1150 $reasonstring.= ', ' if length($reasonstring);
1151 $reasonstring.= $p.' ' if length($p);
1152 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1154 if (length($reasonstring) > 40) {
1155 (substr $reasonstring, 37) = "...";
1157 $reasonstring = "" if (!defined($reasonstring));
1158 push(@maintccs,"$maint ($reasonstring)");
1159 push(@maintccaddrs,"$maint");
1164 &transcript("MC|@maintccs|\n") if $dl>2;
1165 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1168 # Add Bcc's to subscribed bugs
1169 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1171 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1172 $header{'subject'} = "your mail";
1175 # Error text here advertises how many errors there were
1176 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1179 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1181 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1182 In-Reply-To: $header{'message-id'}
1183 References: $header{'message-id'}
1184 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1186 X-$gProject-PR-Message: transcript
1188 ${transcript}Please contact me if you need assistance.
1191 (administrator, $gProject $gBugs database)
1195 $repliedshow= join(', ',$replyto,@maintccaddrs);
1196 &filelock("lock/-1");
1197 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1199 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1201 "<strong>Request received</strong> from <code>".
1202 html_escape($header{'from'})."</code>\n".
1203 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1205 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1206 close(AP) || &quit("open db-h/-1.log: $!");
1208 utime(time,time,"db-h");
1210 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1212 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1214 sub sendmailmessage {
1215 local ($message,@recips) = @_;
1216 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1217 send_mail_message(message => $message,
1218 recipients => \@recips,
1224 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1225 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1229 #sub unimplemented {
1230 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1234 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1236 if (@newmergelist) {
1237 eval "\$mvarvalue= \$$mvarname";
1238 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1241 "Values for \`$string' don't match:\n".
1242 " #$newmergelist[0] has \`$mvarvalue';\n".
1243 " #$ref has \`$svarvalue'\n"
1244 if $mvarvalue ne $svarvalue;
1246 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1248 eval "\$$mvarname= \$svarvalue";
1253 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1254 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1266 my %h = map { $_ => 1 } split ' ', $list;
1273 return join ' ', sort keys %h;
1276 # High-level bug manipulation calls
1277 # Do announcements themselves
1279 # Possible calling sequences:
1280 # setbug (returns 0)
1282 # setbug (returns 1)
1283 # &transcript(something)
1286 # setbug (returns 1)
1287 # $action= (something)
1289 # (modify s_* variables)
1290 # } while (getnextbug);
1293 &dlen("nochangebug");
1294 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1296 &endmerge if $manybugs;
1298 &dlex("nochangebug");
1302 &dlen("setbug $ref");
1303 if ($ref =~ m/^-\d+/) {
1304 if (!defined $clonebugs{$ref}) {
1306 &dlex("setbug => noclone");
1309 $ref = $clonebugs{$ref};
1311 $state eq 'idle' || die "$state ?";
1314 &dlex("setbug => 0s");
1318 if (!&checkpkglimit) {
1323 @thisbugmergelist= split(/ /,$data->{mergedwith});
1324 if (!@thisbugmergelist) {
1329 &dlex("setbug => 1s");
1338 &dlex("setbug => 0mc");
1342 $state= 'multiple'; $sref=$ref;
1343 &dlex("setbug => 1m");
1348 &dlen("getnextbug");
1349 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1351 if (!$manybugs || !@thisbugmergelist) {
1352 length($action) || die;
1353 &transcript("$action\n$extramessage\n");
1354 &endmerge if $manybugs;
1356 &dlex("getnextbug => 0");
1359 $ref= shift(@thisbugmergelist);
1360 &getbug || die "bug $ref disappeared";
1362 &dlex("getnextbug => 1");
1366 # Low-level bug-manipulation calls
1367 # Do no announcements
1369 # getbug (returns 0)
1371 # getbug (returns 1)
1375 # $action= (something)
1376 # getbug (returns 1)
1378 # getbug (returns 1)
1380 # [getbug (returns 0)]
1381 # &transcript("$action\n\n")
1384 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1385 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1389 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1390 &filelock('lock/merge');
1391 $mergelowstate='locked';
1397 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1399 $mergelowstate='idle';
1404 &dlen("getbug $ref");
1405 $lowstate eq 'idle' || die "$state ?";
1406 if (($data = &lockreadbug($ref))) {
1409 &dlex("getbug => 1");
1414 &dlex("getbug => 0");
1420 $lowstate eq 'open' || die "$state ?";
1427 &dlen("savebug $ref");
1428 $lowstate eq 'open' || die "$lowstate ?";
1429 length($action) || die;
1430 $ref == $sref || die "read $sref but saving $ref ?";
1431 my $hash = get_hashname($ref);
1432 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1435 "<!-- time:".time." -->\n".
1436 "<strong>".html_escape($action)."</strong>\n".
1437 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1438 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1440 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1441 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1442 unlockwritebug($ref, $data);
1449 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1454 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1458 print $_[0] if $debug;
1459 $transcript.= $_[0];
1466 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1467 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1483 sub sendtxthelpraw {
1484 local ($relpath,$description) = @_;
1486 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1487 while(<D>) { $doc.=$_; }
1489 &transcript("Sending $description in separate message.\n");
1490 &sendmailmessage(<<END.$doc,$replyto);
1491 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1493 Subject: $gProject $gBug help: $description
1494 References: $header{'message-id'}
1495 In-Reply-To: $header{'message-id'}
1496 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1498 X-$gProject-PR-Message: doc-text $relpath
1504 sub sendlynxdocraw {
1505 local ($relpath,$description) = @_;
1507 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1508 while(<L>) { $doc.=$_; }
1510 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1511 &transcript("Information ($description) is not available -\n".
1512 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1515 &transcript("Error getting $description (code $? $!):\n$doc\n");
1517 &transcript("Sending $description.\n");
1518 &sendmailmessage(<<END.$doc,$replyto);
1519 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1521 Subject: $gProject $gBugs information: $description
1522 References: $header{'message-id'}
1523 In-Reply-To: $header{'message-id'}
1524 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1526 X-$gProject-PR-Message: doc-html $relpath
1535 $maintccreasons{$cca}{''}{$ref}= 1;
1538 sub addmaintainers {
1539 # Data structure is:
1540 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1543 &ensuremaintainersloaded;
1544 $anymaintfound=0; $anymaintnotfound=0;
1545 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1547 $p =~ /([a-z0-9.+-]+)/;
1549 next unless defined $p;
1550 if (defined $gSubscriptionDomain) {
1551 if (defined($pkgsrc{$p})) {
1552 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1554 addbcc("$p\@$gSubscriptionDomain");
1557 if (defined $data->{severity} and defined $gStrongList and
1558 isstrongseverity($data->{severity})) {
1559 addbcc("$gStrongList\@$gListDomain");
1561 if (defined($maintainerof{$p})) {
1562 $addmaint= $maintainerof{$p};
1563 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1564 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1565 print "maintainer add >$p|$addmaint<\n" if $debug;
1567 print "maintainer none >$p<\n" if $debug;
1568 &transcript("Warning: Unknown package '$p'\n");
1569 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1570 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1574 if (length $data->{owner}) {
1575 $addmaint = $data->{owner};
1576 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1577 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1578 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1582 sub ensuremaintainersloaded {
1584 return if $maintainersloaded++;
1585 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1589 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1590 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1591 $maintainerof{$a}= $2;
1594 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1598 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1599 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1600 $maintainerof{$a}= $2;
1603 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1605 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1606 my ($a, $b) = ($1, $2);
1607 $pkgsrc{lc($a)} = $b;
1613 local ($wherefrom,$path,$description) = @_;
1614 if ($wherefrom eq "ftp.d.o") {
1615 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1617 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1618 &transcript("$description is not available.\n");
1621 &transcript("Error getting $description (code $? $!):\n$doc\n");
1624 } elsif ($wherefrom eq "local") {
1626 $doc = do { local $/; <P> };
1629 &transcript("internal errror: info files location unknown.\n");
1632 &transcript("Sending $description.\n");
1633 &sendmailmessage(<<END.$doc,$replyto);
1634 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1636 Subject: $gProject $gBugs information: $description
1637 References: $header{'message-id'}
1638 In-Reply-To: $header{'message-id'}
1639 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1641 X-$gProject-PR-Message: getinfo
1643 $description follows: