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 :config);
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+)
511 (?:\s+(?:$config{package_name_re}\/)?
512 ($config{package_version_re}))?$}ix) {
517 if (!length($data->{done}) and not defined($version)) {
518 &transcript("$gBug is already open, cannot reopen.\n\n");
524 "$gBug marked as found in version $version." :
527 &addmaintainers($data);
528 # The 'done' field gets a bit weird with version
529 # tracking, because a bug may be closed by multiple
530 # people in different branches. Until we have something
531 # more flexible, we set it every time a bug is fixed,
532 # and clear it precisely when a found command is
533 # received for the rightmost fixed-in version, which
534 # equates to the most recent fixing of the bug, or when
535 # a versionless found command is received.
536 if (defined $version) {
537 my $lastfixed = $data->{fixed_versions}[-1];
538 # TODO: what if $data->{package} is a source package?
539 addfoundversions($data, $data->{package}, $version, 'binary');
540 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
544 # Versionless found; assume old-style "not fixed at
546 $data->{fixed_versions} = [];
549 } while (&getnextbug);
552 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
557 $action= "$gBug marked as not found in version $version.";
558 if (length($data->{done})) {
559 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
562 &addmaintainers($data);
563 removefoundversions($data, $data->{package}, $version, 'binary');
564 } while (&getnextbug);
567 elsif (m[^fixed\s+\#?(-?\d+)\s+
568 ((?:$config{package_name_re}\/)?
569 $config{package_version_re})\s*$]ix) {
576 "$gBug marked as fixed in version $version." :
579 &addmaintainers($data);
580 addfixedversions($data, $data->{package}, $version, 'binary');
581 } while (&getnextbug);
584 elsif (m[^notfixed\s+\#?(-?\d+)\s+
585 ((?:$config{package_name_re}\/)?
586 $config{package_version_re})\s*$]ix) {
593 "$gBug marked as not fixed in version $version." :
596 &addmaintainers($data);
597 removefixedversions($data, $data->{package}, $version, 'binary');
598 } while (&getnextbug);
601 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
602 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
605 $bug_affected{$ref}=1;
606 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
607 $ref = $clonebugs{$ref};
610 if (&checkpkglimit) {
612 &addmaintainers($data);
613 $oldsubmitter= $data->{originator};
614 $data->{originator}= $newsubmitter;
615 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
617 &transcript("$action\n");
618 if (length($data->{done})) {
619 &transcript("(By the way, that $gBug is currently marked as done.)\n");
623 From: $gMaintainerEmail ($gProject $gBug Tracking System)
625 Subject: $gBug#$ref submitter address changed
627 References: $header{'message-id'} $data->{msgid}
628 In-Reply-To: $data->{msgid}
629 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
630 Reply-To: $ref\@$gEmailDomain
631 X-$gProject-PR-Message: submitter-changed $ref
633 The submitter address recorded for your $gBug report
634 #$ref: $data->{subject}
637 The old submitter address for this report was
639 The new submitter address is
642 This change was made by
644 If it was incorrect, please contact them directly.
647 (administrator, $gProject $gBugs database)
650 &sendmailmessage($message,$oldsubmitter);
657 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
659 $ref= $1; $whereto= $2;
660 $bug_affected{$ref}=1;
662 if (length($data->{forwarded})) {
663 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
665 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
667 if (length($data->{done})) {
668 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
671 &addmaintainers($data);
672 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
673 &addccaddress("$gForwardList\@$gListDomain");
675 $data->{forwarded}= $whereto;
676 } while (&getnextbug);
678 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
681 $bug_affected{$ref}=1;
683 if (!length($data->{forwarded})) {
684 &transcript("$gBug is not marked as having been forwarded.\n\n");
687 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
689 &addmaintainers($data);
690 $data->{forwarded}= '';
691 } while (&getnextbug);
694 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
695 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
698 $bug_affected{$ref}=1;
700 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
701 &transcript("Severity level \`$newseverity' is not known.\n".
702 "Recognized are: $gShowSeverities.\n\n");
704 } elsif (exists $gObsoleteSeverities{$newseverity}) {
705 &transcript("Severity level \`$newseverity' is obsolete. " .
706 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
709 $printseverity= $data->{severity};
710 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
711 $action= "Severity set to \`$newseverity' from \`$printseverity'";
713 &addmaintainers($data);
714 if (defined $gStrongList and isstrongseverity($newseverity)) {
715 addbcc("$gStrongList\@$gListDomain");
717 $data->{severity}= $newseverity;
718 } while (&getnextbug);
720 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
722 $ref = $1; $addsubcode = $3; $tags = $4;
723 $bug_affected{$ref}=1;
725 if (defined $addsubcode) {
726 $addsub = "sub" if ($addsubcode eq "-");
727 $addsub = "add" if ($addsubcode eq "+");
728 $addsub = "set" if ($addsubcode eq "=");
732 foreach my $t (split /[\s,]+/, $tags) {
733 if (!grep($_ eq $t, @gTags)) {
740 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
741 "Recognized are: ".join(' ', @gTags).".\n\n");
745 if ($data->{keywords} eq '') {
746 &transcript("There were no tags set.\n");
748 &transcript("Tags were: $data->{keywords}\n");
750 if ($addsub eq "set") {
751 $action= "Tags set to: " . join(", ", @okaytags);
752 } elsif ($addsub eq "add") {
753 $action= "Tags added: " . join(", ", @okaytags);
754 } elsif ($addsub eq "sub") {
755 $action= "Tags removed: " . join(", ", @okaytags);
758 &addmaintainers($data);
759 $data->{keywords} = '' if ($addsub eq "set");
760 # Allow removing obsolete tags.
761 if ($addsub eq "sub") {
762 foreach my $t (@badtags) {
763 $data->{keywords} = join ' ', grep $_ ne $t,
764 split ' ', $data->{keywords};
767 # Now process all other additions and subtractions.
768 foreach my $t (@okaytags) {
769 $data->{keywords} = join ' ', grep $_ ne $t,
770 split ' ', $data->{keywords};
771 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
773 $data->{keywords} =~ s/\s*$//;
774 } while (&getnextbug);
776 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
778 my $bugnum = $2; my $blockers = $4;
780 $addsub = "sub" if ($1 eq "un");
781 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
782 $bugnum = $clonebugs{$bugnum};
787 foreach my $b (split /[\s,]+/, $blockers) {
791 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
792 $ref = $clonebugs{$ref};
796 push @okayblockers, $ref;
798 # add to the list all bugs that are merged with $b,
799 # because all of their data must be kept in sync
800 @thisbugmergelist= split(/ /,$data->{mergedwith});
803 foreach $ref (@thisbugmergelist) {
805 push @okayblockers, $ref;
812 push @badblockers, $ref;
816 push @badblockers, $b;
820 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
826 if ($data->{blockedby} eq '') {
827 &transcript("Was not blocked by any bugs.\n");
829 &transcript("Was blocked by: $data->{blockedby}\n");
831 if ($addsub eq "set") {
832 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
833 } elsif ($addsub eq "add") {
834 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
835 } elsif ($addsub eq "sub") {
836 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
841 &addmaintainers($data);
842 my @oldblockerlist = split ' ', $data->{blockedby};
843 $data->{blockedby} = '' if ($addsub eq "set");
844 foreach my $b (@okayblockers) {
845 $data->{blockedby} = manipset($data->{blockedby}, $b,
849 foreach my $b (@oldblockerlist) {
850 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
851 push @{$removedblocks{$b}}, $ref;
854 foreach my $b (split ' ', $data->{blockedby}) {
855 if (! grep { $_ eq $b } @oldblockerlist) {
856 push @{$addedblocks{$b}}, $ref;
859 } while (&getnextbug);
861 # Now that the blockedby data is updated, change blocks data
862 # to match the changes.
863 foreach $ref (keys %addedblocks) {
865 foreach my $b (@{$addedblocks{$ref}}) {
866 $data->{blocks} = manipset($data->{blocks}, $b, 1);
871 foreach $ref (keys %removedblocks) {
873 foreach my $b (@{$removedblocks{$ref}}) {
874 $data->{blocks} = manipset($data->{blocks}, $b, 0);
880 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
882 $ref= $1; $newtitle= $2;
883 $bug_affected{$ref}=1;
884 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
885 $ref = $clonebugs{$ref};
888 if (&checkpkglimit) {
890 &addmaintainers($data);
891 my $oldtitle = $data->{subject};
892 $data->{subject}= $newtitle;
893 $action= "Changed $gBug title to $newtitle from $oldtitle.";
895 &transcript("$action\n");
896 if (length($data->{done})) {
897 &transcript("(By the way, that $gBug is currently marked as done.)\n");
906 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
909 $bug_affected{$ref} = 1;
911 if (!length($data->{mergedwith})) {
912 &transcript("$gBug is not marked as being merged with any others.\n\n");
915 $mergelowstate eq 'locked' || die "$mergelowstate ?";
916 $action= "Disconnected #$ref from all other report(s).";
917 @newmergelist= split(/ /,$data->{mergedwith});
919 @bug_affected{@newmergelist} = 1 x @newmergelist;
921 &addmaintainers($data);
922 $data->{mergedwith}= ($ref == $discref) ? ''
923 : join(' ',grep($_ ne $ref,@newmergelist));
924 } while (&getnextbug);
927 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
929 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
930 my @newmergelist= ();
935 while (defined($ref= shift(@tomerge))) {
936 &transcript("D| checking merge $ref\n") if $dl;
938 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
939 $ref = $clonebugs{$ref};
941 next if grep($_ == $ref,@newmergelist);
942 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
943 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
945 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
947 &checkmatch('package','m_package',$data->{package},@newmergelist);
948 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
949 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
950 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
951 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
952 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
953 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
954 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
955 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
956 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
957 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
958 if (length($mismatch)) {
959 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
962 &cancelbug; @newmergelist=(); last;
964 push(@newmergelist,$ref);
965 push(@tomerge,split(/ /,$data->{mergedwith}));
969 @newmergelist= sort { $a <=> $b } @newmergelist;
970 $action= "Merged @newmergelist.";
971 delete @fixed{keys %found};
972 for $ref (@newmergelist) {
973 &getbug || die "huh ? $gBug $ref disappeared during merge";
974 &addmaintainers($data);
975 @bug_affected{@newmergelist} = 1 x @newmergelist;
976 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
977 $data->{keywords}= join(' ', keys %tags);
978 $data->{found_versions}= [sort keys %found];
979 $data->{fixed_versions}= [sort keys %fixed];
982 &transcript("$action\n\n");
985 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
987 my @temp = split /\s+\#?/,$1;
988 my $master_bug = shift @temp;
990 my @tomerge = sort { $a <=> $b } @temp;
991 unshift @tomerge,$master_bug;
992 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
993 my @newmergelist= ();
997 # Here we try to do the right thing.
998 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
999 # If not, we discard the found and fixed.
1000 # Everything else we set to the values of the first bug.
1002 while (defined($ref= shift(@tomerge))) {
1003 &transcript("D| checking merge $ref\n") if $dl;
1005 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1006 $ref = $clonebugs{$ref};
1008 next if grep($_ == $ref,@newmergelist);
1009 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1010 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1012 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1013 $master_bug_data = $data if not defined $master_bug_data;
1014 if ($data->{package} ne $master_bug_data->{package}) {
1015 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1016 "$gBug $ref is not in the same package as $master_bug\n");
1018 &cancelbug; @newmergelist=(); last;
1020 for my $t (split /\s+/,$data->{keywords}) {
1023 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1024 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1025 push(@newmergelist,$ref);
1026 push(@tomerge,split(/ /,$data->{mergedwith}));
1029 if (@newmergelist) {
1030 @newmergelist= sort { $a <=> $b } @newmergelist;
1031 $action= "Forcibly Merged @newmergelist.";
1032 delete @fixed{keys %found};
1033 for $ref (@newmergelist) {
1034 &getbug || die "huh ? $gBug $ref disappeared during merge";
1035 &addmaintainers($data);
1036 @bug_affected{@newmergelist} = 1 x @newmergelist;
1037 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1038 $data->{keywords}= join(' ', keys %tags);
1039 $data->{found_versions}= [sort keys %found];
1040 $data->{fixed_versions}= [sort keys %fixed];
1041 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1042 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1045 &transcript("$action\n\n");
1048 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1052 @newclonedids = split /\s+/, $2;
1053 $newbugsneeded = scalar(@newclonedids);
1056 $bug_affected{$ref} = 1;
1058 if (length($data->{mergedwith})) {
1059 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1063 &filelock("nextnumber.lock");
1064 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1065 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1066 $firstref= $v+0; $v += $newbugsneeded;
1067 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1070 $lastref = $firstref + $newbugsneeded - 1;
1072 if ($newbugsneeded == 1) {
1073 $action= "$gBug $origref cloned as bug $firstref.";
1075 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1078 my $blocks = $data->{blocks};
1079 my $blockedby = $data->{blockedby};
1082 my $ohash = get_hashname($origref);
1083 my $clone = $firstref;
1084 @bug_affected{@newclonedids} = 1 x @newclonedids;
1085 for $newclonedid (@newclonedids) {
1086 $clonebugs{$newclonedid} = $clone;
1088 my $hash = get_hashname($clone);
1089 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1090 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1091 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1092 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1093 &bughook('new', $clone, $data);
1095 # Update blocking info of bugs blocked by or blocking the
1097 foreach $ref (split ' ', $blocks) {
1099 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1102 foreach $ref (split ' ', $blockedby) {
1104 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1112 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1114 my @pkgs = split /\s+/, $1;
1115 if (scalar(@pkgs) > 0) {
1116 %limit_pkgs = map { ($_, 1) } @pkgs;
1117 &transcript("Ignoring bugs not assigned to: " .
1118 join(" ", keys(%limit_pkgs)) . "\n\n");
1121 &transcript("Not ignoring any bugs.\n\n");
1123 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1124 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1127 $bug_affected{$ref} = 1;
1129 if (length $data->{owner}) {
1130 $action = "Owner changed from $data->{owner} to $newowner.";
1132 $action = "Owner recorded as $newowner.";
1134 if (length $data->{done}) {
1135 $extramessage = "(By the way, this $gBug is currently " .
1136 "marked as done.)\n";
1139 &addmaintainers($data);
1140 $data->{owner} = $newowner;
1141 } while (&getnextbug);
1143 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1146 $bug_affected{$ref} = 1;
1148 if (length $data->{owner}) {
1149 $action = "Removed annotation that $gBug was owned by " .
1152 &addmaintainers($data);
1153 $data->{owner} = '';
1154 } while (&getnextbug);
1156 &transcript("$gBug is not marked as having an owner.\n\n");
1161 &transcript("Unknown command or malformed arguments to command.\n\n");
1163 if (++$unknowns >= 5) {
1164 &transcript("Too many unknown commands, stopping here.\n\n");
1169 if ($procline>$#bodylines) {
1170 &transcript(">\nEnd of message, stopping processing here.\n\n");
1172 if (!$ok && !quickabort) {
1174 &transcript("No commands successfully parsed; sending the help text(s).\n");
1179 &transcript("MC\n") if $dl>1;
1181 for $maint (keys %maintccreasons) {
1182 &transcript("MM|$maint|\n") if $dl>1;
1183 next if $maint eq $replyto;
1185 $reasonsref= $maintccreasons{$maint};
1186 &transcript("MY|$maint|\n") if $dl>2;
1187 for $p (sort keys %$reasonsref) {
1188 &transcript("MP|$p|\n") if $dl>2;
1189 $reasonstring.= ', ' if length($reasonstring);
1190 $reasonstring.= $p.' ' if length($p);
1191 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1193 if (length($reasonstring) > 40) {
1194 (substr $reasonstring, 37) = "...";
1196 $reasonstring = "" if (!defined($reasonstring));
1197 push(@maintccs,"$maint ($reasonstring)");
1198 push(@maintccaddrs,"$maint");
1203 &transcript("MC|@maintccs|\n") if $dl>2;
1204 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1207 # Add Bcc's to subscribed bugs
1208 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1210 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1211 $header{'subject'} = "your mail";
1214 # Error text here advertises how many errors there were
1215 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1218 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1220 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1221 In-Reply-To: $header{'message-id'}
1222 References: $header{'message-id'}
1223 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1225 X-$gProject-PR-Message: transcript
1227 ${transcript}Please contact me if you need assistance.
1230 (administrator, $gProject $gBugs database)
1234 $repliedshow= join(', ',$replyto,@maintccaddrs);
1235 &filelock("lock/-1");
1236 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1238 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1240 "<strong>Request received</strong> from <code>".
1241 html_escape($header{'from'})."</code>\n".
1242 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1244 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1245 close(AP) || &quit("open db-h/-1.log: $!");
1247 utime(time,time,"db-h");
1249 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1251 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1253 sub sendmailmessage {
1254 local ($message,@recips) = @_;
1255 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1256 send_mail_message(message => $message,
1257 recipients => \@recips,
1263 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1264 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1268 #sub unimplemented {
1269 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1273 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1275 if (@newmergelist) {
1276 eval "\$mvarvalue= \$$mvarname";
1277 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1280 "Values for \`$string' don't match:\n".
1281 " #$newmergelist[0] has \`$mvarvalue';\n".
1282 " #$ref has \`$svarvalue'\n"
1283 if $mvarvalue ne $svarvalue;
1285 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1287 eval "\$$mvarname= \$svarvalue";
1292 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1293 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1305 my %h = map { $_ => 1 } split ' ', $list;
1312 return join ' ', sort keys %h;
1315 # High-level bug manipulation calls
1316 # Do announcements themselves
1318 # Possible calling sequences:
1319 # setbug (returns 0)
1321 # setbug (returns 1)
1322 # &transcript(something)
1325 # setbug (returns 1)
1326 # $action= (something)
1328 # (modify s_* variables)
1329 # } while (getnextbug);
1332 &dlen("nochangebug");
1333 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1335 &endmerge if $manybugs;
1337 &dlex("nochangebug");
1341 &dlen("setbug $ref");
1342 if ($ref =~ m/^-\d+/) {
1343 if (!defined $clonebugs{$ref}) {
1345 &dlex("setbug => noclone");
1348 $ref = $clonebugs{$ref};
1350 $state eq 'idle' || die "$state ?";
1353 &dlex("setbug => 0s");
1357 if (!&checkpkglimit) {
1362 @thisbugmergelist= split(/ /,$data->{mergedwith});
1363 if (!@thisbugmergelist) {
1368 &dlex("setbug => 1s");
1377 &dlex("setbug => 0mc");
1381 $state= 'multiple'; $sref=$ref;
1382 &dlex("setbug => 1m");
1387 &dlen("getnextbug");
1388 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1390 if (!$manybugs || !@thisbugmergelist) {
1391 length($action) || die;
1392 &transcript("$action\n$extramessage\n");
1393 &endmerge if $manybugs;
1395 &dlex("getnextbug => 0");
1398 $ref= shift(@thisbugmergelist);
1399 &getbug || die "bug $ref disappeared";
1401 &dlex("getnextbug => 1");
1405 # Low-level bug-manipulation calls
1406 # Do no announcements
1408 # getbug (returns 0)
1410 # getbug (returns 1)
1414 # $action= (something)
1415 # getbug (returns 1)
1417 # getbug (returns 1)
1419 # [getbug (returns 0)]
1420 # &transcript("$action\n\n")
1423 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1424 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1428 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1429 &filelock('lock/merge');
1430 $mergelowstate='locked';
1436 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1438 $mergelowstate='idle';
1443 &dlen("getbug $ref");
1444 $lowstate eq 'idle' || die "$state ?";
1445 if (($data = &lockreadbug($ref))) {
1448 &dlex("getbug => 1");
1453 &dlex("getbug => 0");
1459 $lowstate eq 'open' || die "$state ?";
1466 &dlen("savebug $ref");
1467 $lowstate eq 'open' || die "$lowstate ?";
1468 length($action) || die;
1469 $ref == $sref || die "read $sref but saving $ref ?";
1470 my $hash = get_hashname($ref);
1471 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1474 "<!-- time:".time." -->\n".
1475 "<strong>".html_escape($action)."</strong>\n".
1476 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1477 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1479 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1480 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1481 unlockwritebug($ref, $data);
1488 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1493 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1497 print $_[0] if $debug;
1498 $transcript.= $_[0];
1505 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1506 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1522 sub sendtxthelpraw {
1523 local ($relpath,$description) = @_;
1525 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1526 while(<D>) { $doc.=$_; }
1528 &transcript("Sending $description in separate message.\n");
1529 &sendmailmessage(<<END.$doc,$replyto);
1530 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1532 Subject: $gProject $gBug help: $description
1533 References: $header{'message-id'}
1534 In-Reply-To: $header{'message-id'}
1535 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1537 X-$gProject-PR-Message: doc-text $relpath
1543 sub sendlynxdocraw {
1544 local ($relpath,$description) = @_;
1546 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1547 while(<L>) { $doc.=$_; }
1549 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1550 &transcript("Information ($description) is not available -\n".
1551 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1554 &transcript("Error getting $description (code $? $!):\n$doc\n");
1556 &transcript("Sending $description.\n");
1557 &sendmailmessage(<<END.$doc,$replyto);
1558 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1560 Subject: $gProject $gBugs information: $description
1561 References: $header{'message-id'}
1562 In-Reply-To: $header{'message-id'}
1563 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1565 X-$gProject-PR-Message: doc-html $relpath
1574 $maintccreasons{$cca}{''}{$ref}= 1;
1577 sub addmaintainers {
1578 # Data structure is:
1579 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1582 &ensuremaintainersloaded;
1583 $anymaintfound=0; $anymaintnotfound=0;
1584 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1586 $p =~ /([a-z0-9.+-]+)/;
1588 next unless defined $p;
1589 if (defined $gSubscriptionDomain) {
1590 if (defined($pkgsrc{$p})) {
1591 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1593 addbcc("$p\@$gSubscriptionDomain");
1596 if (defined $data->{severity} and defined $gStrongList and
1597 isstrongseverity($data->{severity})) {
1598 addbcc("$gStrongList\@$gListDomain");
1600 if (defined($maintainerof{$p})) {
1601 $addmaint= $maintainerof{$p};
1602 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1603 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1604 print "maintainer add >$p|$addmaint<\n" if $debug;
1606 print "maintainer none >$p<\n" if $debug;
1607 &transcript("Warning: Unknown package '$p'\n");
1608 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1609 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1613 if (length $data->{owner}) {
1614 $addmaint = $data->{owner};
1615 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1616 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1617 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1621 sub ensuremaintainersloaded {
1623 return if $maintainersloaded++;
1624 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1628 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1629 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1630 $maintainerof{$a}= $2;
1633 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1637 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1638 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1639 $maintainerof{$a}= $2;
1642 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1644 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1645 my ($a, $b) = ($1, $2);
1646 $pkgsrc{lc($a)} = $b;
1652 local ($wherefrom,$path,$description) = @_;
1653 if ($wherefrom eq "ftp.d.o") {
1654 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1656 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1657 &transcript("$description is not available.\n");
1660 &transcript("Error getting $description (code $? $!):\n$doc\n");
1663 } elsif ($wherefrom eq "local") {
1665 $doc = do { local $/; <P> };
1668 &transcript("internal errror: info files location unknown.\n");
1671 &transcript("Sending $description.\n");
1672 &sendmailmessage(<<END.$doc,$replyto);
1673 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1675 Subject: $gProject $gBugs information: $description
1676 References: $header{'message-id'}
1677 In-Reply-To: $header{'message-id'}
1678 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1680 X-$gProject-PR-Message: getinfo
1682 $description follows: