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;
346 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
347 $ref = $clonebugs{$ref};
350 &transcript("No valid user selected\n");
355 Debbugs::User::read_usertags(\%ut, $user);
356 my @oldtags = (); my @newtags = (); my @badtags = ();
358 for my $t (split /[,\s]+/, $tags) {
359 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
366 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
369 for my $t (keys %chtags) {
370 $ut{$t} = [] unless defined $ut{$t};
372 for my $t (keys %ut) {
373 my %res = map { ($_, 1) } @{$ut{$t}};
374 push @oldtags, $t if defined $res{$ref};
375 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
376 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
377 : $addsubcode eq "=");
378 $res{$ref} = 1 if ($addop && defined $chtags{$t});
379 delete $res{$ref} if ($del);
380 push @newtags, $t if defined $res{$ref};
381 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
384 &transcript("There were no usertags set.\n");
386 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
388 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
389 Debbugs::User::write_usertags(\%ut, $user);
391 } elsif (!$control) {
393 Unknown command or malformed arguments to command.
394 (Use control\@$gEmailDomain to manipulate reports.)
398 if (++$unknowns >= 3) {
399 &transcript("Too many unknown commands, stopping here.\n\n");
402 #### "developer only" ones start here
403 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
406 $bug_affected{$ref}=1;
409 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
410 if (length($data->{done}) and not defined($version)) {
411 &transcript("$gBug is already closed, cannot re-close.\n\n");
416 "marked as fixed in version $version" :
418 ", send any further explanations to $data->{originator}";
420 &addmaintainers($data);
421 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
422 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
423 $data->{done}= $replyto;
424 my @keywords= split ' ', $data->{keywords};
425 if (grep $_ eq 'pending', @keywords) {
426 $extramessage= "Removed pending tag.\n";
427 $data->{keywords}= join ' ', grep $_ ne 'pending',
430 addfixedversions($data, $data->{package}, $version, 'binary');
433 From: $gMaintainerEmail ($gProject $gBug Tracking System)
434 To: $data->{originator}
435 Subject: $gBug#$ref acknowledged by developer
437 References: $header{'message-id'} $data->{msgid}
438 In-Reply-To: $data->{msgid}
439 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
440 Reply-To: $ref\@$gEmailDomain
441 X-$gProject-PR-Message: they-closed-control $ref
443 This is an automatic notification regarding your $gBug report
444 #$ref: $data->{subject},
445 which was filed against the $data->{package} package.
447 It has been marked as closed by one of the developers, namely
450 You should be hearing from them with a substantive response shortly,
451 in case you haven't already. If not, please contact them directly.
454 (administrator, $gProject $gBugs database)
457 &sendmailmessage($message,$data->{originator});
458 } while (&getnextbug);
461 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
463 $ref= $1; $newpackage= $2;
464 $bug_affected{$ref}=1;
466 $newpackage =~ y/A-Z/a-z/;
468 if (length($data->{package})) {
469 $action= "$gBug reassigned from package \`$data->{package}'".
470 " to \`$newpackage'.";
472 $action= "$gBug assigned to package \`$newpackage'.";
475 &addmaintainers($data);
476 $data->{package}= $newpackage;
477 $data->{found_versions}= [];
478 $data->{fixed_versions}= [];
479 # TODO: what if $newpackage is a source package?
480 addfoundversions($data, $data->{package}, $version, 'binary');
481 &addmaintainers($data);
482 } while (&getnextbug);
484 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
485 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
486 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
487 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
490 $bug_affected{$ref}=1;
492 if (@{$data->{fixed_versions}}) {
493 &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");
495 if (!length($data->{done})) {
496 &transcript("$gBug is already open, cannot reopen.\n\n");
500 $noriginator eq '' ? "$gBug reopened, originator not changed." :
501 "$gBug reopened, originator set to $noriginator.";
503 &addmaintainers($data);
504 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
505 $data->{fixed_versions}= [];
507 } while (&getnextbug);
510 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
515 if (!length($data->{done}) and not defined($version)) {
516 &transcript("$gBug is already open, cannot reopen.\n\n");
522 "$gBug marked as found in version $version." :
525 &addmaintainers($data);
526 # The 'done' field gets a bit weird with version
527 # tracking, because a bug may be closed by multiple
528 # people in different branches. Until we have something
529 # more flexible, we set it every time a bug is fixed,
530 # and clear it precisely when a found command is
531 # received for the rightmost fixed-in version, which
532 # equates to the most recent fixing of the bug, or when
533 # a versionless found command is received.
534 if (defined $version) {
535 my $lastfixed = $data->{fixed_versions}[-1];
536 # TODO: what if $data->{package} is a source package?
537 addfoundversions($data, $data->{package}, $version, 'binary');
538 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
542 # Versionless found; assume old-style "not fixed at
544 $data->{fixed_versions} = [];
547 } while (&getnextbug);
550 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
555 $action= "$gBug marked as not found in version $version.";
556 if (length($data->{done})) {
557 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
560 &addmaintainers($data);
561 removefoundversions($data, $data->{package}, $version, 'binary');
562 } while (&getnextbug);
564 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
565 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
568 $bug_affected{$ref}=1;
569 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
570 $ref = $clonebugs{$ref};
573 if (&checkpkglimit) {
575 &addmaintainers($data);
576 $oldsubmitter= $data->{originator};
577 $data->{originator}= $newsubmitter;
578 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
580 &transcript("$action\n");
581 if (length($data->{done})) {
582 &transcript("(By the way, that $gBug is currently marked as done.)\n");
586 From: $gMaintainerEmail ($gProject $gBug Tracking System)
588 Subject: $gBug#$ref submitter address changed
590 References: $header{'message-id'} $data->{msgid}
591 In-Reply-To: $data->{msgid}
592 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
593 Reply-To: $ref\@$gEmailDomain
594 X-$gProject-PR-Message: submitter-changed $ref
596 The submitter address recorded for your $gBug report
597 #$ref: $data->{subject}
600 The old submitter address for this report was
602 The new submitter address is
605 This change was made by
607 If it was incorrect, please contact them directly.
610 (administrator, $gProject $gBugs database)
613 &sendmailmessage($message,$oldsubmitter);
620 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
622 $ref= $1; $whereto= $2;
623 $bug_affected{$ref}=1;
625 if (length($data->{forwarded})) {
626 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
628 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
630 if (length($data->{done})) {
631 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
634 &addmaintainers($data);
635 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
636 &addccaddress("$gForwardList\@$gListDomain");
638 $data->{forwarded}= $whereto;
639 } while (&getnextbug);
641 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
644 $bug_affected{$ref}=1;
646 if (!length($data->{forwarded})) {
647 &transcript("$gBug is not marked as having been forwarded.\n\n");
650 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
652 &addmaintainers($data);
653 $data->{forwarded}= '';
654 } while (&getnextbug);
657 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
658 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
661 $bug_affected{$ref}=1;
663 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
664 &transcript("Severity level \`$newseverity' is not known.\n".
665 "Recognized are: $gShowSeverities.\n\n");
667 } elsif (exists $gObsoleteSeverities{$newseverity}) {
668 &transcript("Severity level \`$newseverity' is obsolete. " .
669 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
672 $printseverity= $data->{severity};
673 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
674 $action= "Severity set to \`$newseverity' from \`$printseverity'";
676 &addmaintainers($data);
677 if (defined $gStrongList and isstrongseverity($newseverity)) {
678 addbcc("$gStrongList\@$gListDomain");
680 $data->{severity}= $newseverity;
681 } while (&getnextbug);
683 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
685 $ref = $1; $addsubcode = $3; $tags = $4;
686 $bug_affected{$ref}=1;
688 if (defined $addsubcode) {
689 $addsub = "sub" if ($addsubcode eq "-");
690 $addsub = "add" if ($addsubcode eq "+");
691 $addsub = "set" if ($addsubcode eq "=");
695 foreach my $t (split /[\s,]+/, $tags) {
696 if (!grep($_ eq $t, @gTags)) {
703 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
704 "Recognized are: ".join(' ', @gTags).".\n\n");
708 if ($data->{keywords} eq '') {
709 &transcript("There were no tags set.\n");
711 &transcript("Tags were: $data->{keywords}\n");
713 if ($addsub eq "set") {
714 $action= "Tags set to: " . join(", ", @okaytags);
715 } elsif ($addsub eq "add") {
716 $action= "Tags added: " . join(", ", @okaytags);
717 } elsif ($addsub eq "sub") {
718 $action= "Tags removed: " . join(", ", @okaytags);
721 &addmaintainers($data);
722 $data->{keywords} = '' if ($addsub eq "set");
723 # Allow removing obsolete tags.
724 if ($addsub eq "sub") {
725 foreach my $t (@badtags) {
726 $data->{keywords} = join ' ', grep $_ ne $t,
727 split ' ', $data->{keywords};
730 # Now process all other additions and subtractions.
731 foreach my $t (@okaytags) {
732 $data->{keywords} = join ' ', grep $_ ne $t,
733 split ' ', $data->{keywords};
734 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
736 $data->{keywords} =~ s/\s*$//;
737 } while (&getnextbug);
739 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
741 my $bugnum = $2; my $blockers = $4;
743 $addsub = "sub" if ($1 eq "un");
744 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
745 $bugnum = $clonebugs{$bugnum};
750 foreach my $b (split /[\s,]+/, $blockers) {
754 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
755 $ref = $clonebugs{$ref};
759 push @okayblockers, $ref;
761 # add to the list all bugs that are merged with $b,
762 # because all of their data must be kept in sync
763 @thisbugmergelist= split(/ /,$data->{mergedwith});
766 foreach $ref (@thisbugmergelist) {
768 push @okayblockers, $ref;
775 push @badblockers, $ref;
779 push @badblockers, $b;
783 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
789 if ($data->{blockedby} eq '') {
790 &transcript("Was not blocked by any bugs.\n");
792 &transcript("Was blocked by: $data->{blockedby}\n");
794 if ($addsub eq "set") {
795 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
796 } elsif ($addsub eq "add") {
797 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
798 } elsif ($addsub eq "sub") {
799 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
804 &addmaintainers($data);
805 my @oldblockerlist = split ' ', $data->{blockedby};
806 $data->{blockedby} = '' if ($addsub eq "set");
807 foreach my $b (@okayblockers) {
808 $data->{blockedby} = manipset($data->{blockedby}, $b,
812 foreach my $b (@oldblockerlist) {
813 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
814 push @{$removedblocks{$b}}, $ref;
817 foreach my $b (split ' ', $data->{blockedby}) {
818 if (! grep { $_ eq $b } @oldblockerlist) {
819 push @{$addedblocks{$b}}, $ref;
822 } while (&getnextbug);
824 # Now that the blockedby data is updated, change blocks data
825 # to match the changes.
826 foreach $ref (keys %addedblocks) {
828 foreach my $b (@{$addedblocks{$ref}}) {
829 $data->{blocks} = manipset($data->{blocks}, $b, 1);
834 foreach $ref (keys %removedblocks) {
836 foreach my $b (@{$removedblocks{$ref}}) {
837 $data->{blocks} = manipset($data->{blocks}, $b, 0);
843 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
845 $ref= $1; $newtitle= $2;
846 $bug_affected{$ref}=1;
847 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
848 $ref = $clonebugs{$ref};
851 if (&checkpkglimit) {
853 &addmaintainers($data);
854 my $oldtitle = $data->{subject};
855 $data->{subject}= $newtitle;
856 $action= "Changed $gBug title to $newtitle from $oldtitle.";
858 &transcript("$action\n");
859 if (length($data->{done})) {
860 &transcript("(By the way, that $gBug is currently marked as done.)\n");
869 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
872 $bug_affected{$ref} = 1;
874 if (!length($data->{mergedwith})) {
875 &transcript("$gBug is not marked as being merged with any others.\n\n");
878 $mergelowstate eq 'locked' || die "$mergelowstate ?";
879 $action= "Disconnected #$ref from all other report(s).";
880 @newmergelist= split(/ /,$data->{mergedwith});
882 @bug_affected{@newmergelist} = 1 x @newmergelist;
884 &addmaintainers($data);
885 $data->{mergedwith}= ($ref == $discref) ? ''
886 : join(' ',grep($_ ne $ref,@newmergelist));
887 } while (&getnextbug);
890 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
892 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
893 my @newmergelist= ();
898 while (defined($ref= shift(@tomerge))) {
899 &transcript("D| checking merge $ref\n") if $dl;
901 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
902 $ref = $clonebugs{$ref};
904 next if grep($_ == $ref,@newmergelist);
905 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
906 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
908 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
910 &checkmatch('package','m_package',$data->{package},@newmergelist);
911 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
912 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
913 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
914 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
915 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
916 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
917 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
918 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
919 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
920 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
921 if (length($mismatch)) {
922 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
925 &cancelbug; @newmergelist=(); last;
927 push(@newmergelist,$ref);
928 push(@tomerge,split(/ /,$data->{mergedwith}));
932 @newmergelist= sort { $a <=> $b } @newmergelist;
933 $action= "Merged @newmergelist.";
934 delete @fixed{keys %found};
935 for $ref (@newmergelist) {
936 &getbug || die "huh ? $gBug $ref disappeared during merge";
937 &addmaintainers($data);
938 @bug_affected{@newmergelist} = 1 x @newmergelist;
939 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
940 $data->{keywords}= join(' ', keys %tags);
941 $data->{found_versions}= [sort keys %found];
942 $data->{fixed_versions}= [sort keys %fixed];
945 &transcript("$action\n\n");
948 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
950 my @temp = split /\s+\#?/,$1;
951 my $master_bug = shift @temp;
953 my @tomerge = sort { $a <=> $b } @temp;
954 unshift @tomerge,$master_bug;
955 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
956 my @newmergelist= ();
960 # Here we try to do the right thing.
961 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
962 # If not, we discard the found and fixed.
963 # Everything else we set to the values of the first bug.
965 while (defined($ref= shift(@tomerge))) {
966 &transcript("D| checking merge $ref\n") if $dl;
968 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
969 $ref = $clonebugs{$ref};
971 next if grep($_ == $ref,@newmergelist);
972 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
973 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
975 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
976 $master_bug_data = $data if not defined $master_bug_data;
977 if ($data->{package} ne $master_bug_data->{package}) {
978 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
979 "$gBug $ref is not in the same package as $master_bug\n");
981 &cancelbug; @newmergelist=(); last;
983 for my $t (split /\s+/,$data->{keywords}) {
986 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
987 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
988 push(@newmergelist,$ref);
989 push(@tomerge,split(/ /,$data->{mergedwith}));
993 @newmergelist= sort { $a <=> $b } @newmergelist;
994 $action= "Forcibly Merged @newmergelist.";
995 delete @fixed{keys %found};
996 for $ref (@newmergelist) {
997 &getbug || die "huh ? $gBug $ref disappeared during merge";
998 &addmaintainers($data);
999 @bug_affected{@newmergelist} = 1 x @newmergelist;
1000 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1001 $data->{keywords}= join(' ', keys %tags);
1002 $data->{found_versions}= [sort keys %found];
1003 $data->{fixed_versions}= [sort keys %fixed];
1004 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1005 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1008 &transcript("$action\n\n");
1011 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1015 @newclonedids = split /\s+/, $2;
1016 $newbugsneeded = scalar(@newclonedids);
1019 $bug_affected{$ref} = 1;
1021 if (length($data->{mergedwith})) {
1022 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1026 &filelock("nextnumber.lock");
1027 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1028 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1029 $firstref= $v+0; $v += $newbugsneeded;
1030 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1033 $lastref = $firstref + $newbugsneeded - 1;
1035 if ($newbugsneeded == 1) {
1036 $action= "$gBug $origref cloned as bug $firstref.";
1038 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1041 my $blocks = $data->{blocks};
1042 my $blockedby = $data->{blockedby};
1045 my $ohash = get_hashname($origref);
1046 my $clone = $firstref;
1047 @bug_affected{@newclonedids} = 1 x @newclonedids;
1048 for $newclonedid (@newclonedids) {
1049 $clonebugs{$newclonedid} = $clone;
1051 my $hash = get_hashname($clone);
1052 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1053 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1054 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1055 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1056 &bughook('new', $clone, $data);
1058 # Update blocking info of bugs blocked by or blocking the
1060 foreach $ref (split ' ', $blocks) {
1062 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1065 foreach $ref (split ' ', $blockedby) {
1067 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1075 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1077 my @pkgs = split /\s+/, $1;
1078 if (scalar(@pkgs) > 0) {
1079 %limit_pkgs = map { ($_, 1) } @pkgs;
1080 &transcript("Ignoring bugs not assigned to: " .
1081 join(" ", keys(%limit_pkgs)) . "\n\n");
1084 &transcript("Not ignoring any bugs.\n\n");
1086 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1087 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1090 $bug_affected{$ref} = 1;
1092 if (length $data->{owner}) {
1093 $action = "Owner changed from $data->{owner} to $newowner.";
1095 $action = "Owner recorded as $newowner.";
1097 if (length $data->{done}) {
1098 $extramessage = "(By the way, this $gBug is currently " .
1099 "marked as done.)\n";
1102 &addmaintainers($data);
1103 $data->{owner} = $newowner;
1104 } while (&getnextbug);
1106 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1109 $bug_affected{$ref} = 1;
1111 if (length $data->{owner}) {
1112 $action = "Removed annotation that $gBug was owned by " .
1115 &addmaintainers($data);
1116 $data->{owner} = '';
1117 } while (&getnextbug);
1119 &transcript("$gBug is not marked as having an owner.\n\n");
1124 &transcript("Unknown command or malformed arguments to command.\n\n");
1126 if (++$unknowns >= 5) {
1127 &transcript("Too many unknown commands, stopping here.\n\n");
1132 if ($procline>$#bodylines) {
1133 &transcript(">\nEnd of message, stopping processing here.\n\n");
1135 if (!$ok && !quickabort) {
1137 &transcript("No commands successfully parsed; sending the help text(s).\n");
1142 &transcript("MC\n") if $dl>1;
1144 for $maint (keys %maintccreasons) {
1145 &transcript("MM|$maint|\n") if $dl>1;
1146 next if $maint eq $replyto;
1148 $reasonsref= $maintccreasons{$maint};
1149 &transcript("MY|$maint|\n") if $dl>2;
1150 for $p (sort keys %$reasonsref) {
1151 &transcript("MP|$p|\n") if $dl>2;
1152 $reasonstring.= ', ' if length($reasonstring);
1153 $reasonstring.= $p.' ' if length($p);
1154 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1156 if (length($reasonstring) > 40) {
1157 (substr $reasonstring, 37) = "...";
1159 $reasonstring = "" if (!defined($reasonstring));
1160 push(@maintccs,"$maint ($reasonstring)");
1161 push(@maintccaddrs,"$maint");
1166 &transcript("MC|@maintccs|\n") if $dl>2;
1167 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1170 # Add Bcc's to subscribed bugs
1171 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1173 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1174 $header{'subject'} = "your mail";
1177 # Error text here advertises how many errors there were
1178 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1181 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1183 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1184 In-Reply-To: $header{'message-id'}
1185 References: $header{'message-id'}
1186 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1188 X-$gProject-PR-Message: transcript
1190 ${transcript}Please contact me if you need assistance.
1193 (administrator, $gProject $gBugs database)
1197 $repliedshow= join(', ',$replyto,@maintccaddrs);
1198 &filelock("lock/-1");
1199 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1201 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1203 "<strong>Request received</strong> from <code>".
1204 html_escape($header{'from'})."</code>\n".
1205 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1207 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1208 close(AP) || &quit("open db-h/-1.log: $!");
1210 utime(time,time,"db-h");
1212 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1214 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1216 sub sendmailmessage {
1217 local ($message,@recips) = @_;
1218 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1219 send_mail_message(message => $message,
1220 recipients => \@recips,
1226 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1227 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1231 #sub unimplemented {
1232 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1236 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1238 if (@newmergelist) {
1239 eval "\$mvarvalue= \$$mvarname";
1240 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1243 "Values for \`$string' don't match:\n".
1244 " #$newmergelist[0] has \`$mvarvalue';\n".
1245 " #$ref has \`$svarvalue'\n"
1246 if $mvarvalue ne $svarvalue;
1248 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1250 eval "\$$mvarname= \$svarvalue";
1255 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1256 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1268 my %h = map { $_ => 1 } split ' ', $list;
1275 return join ' ', sort keys %h;
1278 # High-level bug manipulation calls
1279 # Do announcements themselves
1281 # Possible calling sequences:
1282 # setbug (returns 0)
1284 # setbug (returns 1)
1285 # &transcript(something)
1288 # setbug (returns 1)
1289 # $action= (something)
1291 # (modify s_* variables)
1292 # } while (getnextbug);
1295 &dlen("nochangebug");
1296 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1298 &endmerge if $manybugs;
1300 &dlex("nochangebug");
1304 &dlen("setbug $ref");
1305 if ($ref =~ m/^-\d+/) {
1306 if (!defined $clonebugs{$ref}) {
1308 &dlex("setbug => noclone");
1311 $ref = $clonebugs{$ref};
1313 $state eq 'idle' || die "$state ?";
1316 &dlex("setbug => 0s");
1320 if (!&checkpkglimit) {
1325 @thisbugmergelist= split(/ /,$data->{mergedwith});
1326 if (!@thisbugmergelist) {
1331 &dlex("setbug => 1s");
1340 &dlex("setbug => 0mc");
1344 $state= 'multiple'; $sref=$ref;
1345 &dlex("setbug => 1m");
1350 &dlen("getnextbug");
1351 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1353 if (!$manybugs || !@thisbugmergelist) {
1354 length($action) || die;
1355 &transcript("$action\n$extramessage\n");
1356 &endmerge if $manybugs;
1358 &dlex("getnextbug => 0");
1361 $ref= shift(@thisbugmergelist);
1362 &getbug || die "bug $ref disappeared";
1364 &dlex("getnextbug => 1");
1368 # Low-level bug-manipulation calls
1369 # Do no announcements
1371 # getbug (returns 0)
1373 # getbug (returns 1)
1377 # $action= (something)
1378 # getbug (returns 1)
1380 # getbug (returns 1)
1382 # [getbug (returns 0)]
1383 # &transcript("$action\n\n")
1386 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1387 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1391 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1392 &filelock('lock/merge');
1393 $mergelowstate='locked';
1399 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1401 $mergelowstate='idle';
1406 &dlen("getbug $ref");
1407 $lowstate eq 'idle' || die "$state ?";
1408 if (($data = &lockreadbug($ref))) {
1411 &dlex("getbug => 1");
1416 &dlex("getbug => 0");
1422 $lowstate eq 'open' || die "$state ?";
1429 &dlen("savebug $ref");
1430 $lowstate eq 'open' || die "$lowstate ?";
1431 length($action) || die;
1432 $ref == $sref || die "read $sref but saving $ref ?";
1433 my $hash = get_hashname($ref);
1434 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1437 "<!-- time:".time." -->\n".
1438 "<strong>".html_escape($action)."</strong>\n".
1439 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1440 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1442 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1443 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1444 unlockwritebug($ref, $data);
1451 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1456 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1460 print $_[0] if $debug;
1461 $transcript.= $_[0];
1468 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1469 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1485 sub sendtxthelpraw {
1486 local ($relpath,$description) = @_;
1488 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1489 while(<D>) { $doc.=$_; }
1491 &transcript("Sending $description in separate message.\n");
1492 &sendmailmessage(<<END.$doc,$replyto);
1493 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1495 Subject: $gProject $gBug help: $description
1496 References: $header{'message-id'}
1497 In-Reply-To: $header{'message-id'}
1498 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1500 X-$gProject-PR-Message: doc-text $relpath
1506 sub sendlynxdocraw {
1507 local ($relpath,$description) = @_;
1509 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1510 while(<L>) { $doc.=$_; }
1512 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1513 &transcript("Information ($description) is not available -\n".
1514 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1517 &transcript("Error getting $description (code $? $!):\n$doc\n");
1519 &transcript("Sending $description.\n");
1520 &sendmailmessage(<<END.$doc,$replyto);
1521 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1523 Subject: $gProject $gBugs information: $description
1524 References: $header{'message-id'}
1525 In-Reply-To: $header{'message-id'}
1526 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1528 X-$gProject-PR-Message: doc-html $relpath
1537 $maintccreasons{$cca}{''}{$ref}= 1;
1540 sub addmaintainers {
1541 # Data structure is:
1542 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1545 &ensuremaintainersloaded;
1546 $anymaintfound=0; $anymaintnotfound=0;
1547 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1549 $p =~ /([a-z0-9.+-]+)/;
1551 next unless defined $p;
1552 if (defined $gSubscriptionDomain) {
1553 if (defined($pkgsrc{$p})) {
1554 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1556 addbcc("$p\@$gSubscriptionDomain");
1559 if (defined $data->{severity} and defined $gStrongList and
1560 isstrongseverity($data->{severity})) {
1561 addbcc("$gStrongList\@$gListDomain");
1563 if (defined($maintainerof{$p})) {
1564 $addmaint= $maintainerof{$p};
1565 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1566 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1567 print "maintainer add >$p|$addmaint<\n" if $debug;
1569 print "maintainer none >$p<\n" if $debug;
1570 &transcript("Warning: Unknown package '$p'\n");
1571 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1572 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1576 if (length $data->{owner}) {
1577 $addmaint = $data->{owner};
1578 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1579 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1580 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1584 sub ensuremaintainersloaded {
1586 return if $maintainersloaded++;
1587 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1591 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1592 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1593 $maintainerof{$a}= $2;
1596 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1600 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1601 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1602 $maintainerof{$a}= $2;
1605 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1607 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1608 my ($a, $b) = ($1, $2);
1609 $pkgsrc{lc($a)} = $b;
1615 local ($wherefrom,$path,$description) = @_;
1616 if ($wherefrom eq "ftp.d.o") {
1617 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1619 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1620 &transcript("$description is not available.\n");
1623 &transcript("Error getting $description (code $? $!):\n$doc\n");
1626 } elsif ($wherefrom eq "local") {
1628 $doc = do { local $/; <P> };
1631 &transcript("internal errror: info files location unknown.\n");
1634 &transcript("Sending $description.\n");
1635 &sendmailmessage(<<END.$doc,$replyto);
1636 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1638 Subject: $gProject $gBugs information: $description
1639 References: $header{'message-id'}
1640 In-Reply-To: $header{'message-id'}
1641 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1643 X-$gProject-PR-Message: getinfo
1645 $description follows: