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));
143 my $indicated_user = 0;
147 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
148 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
149 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
150 &transcript("Have a nice day\n\n.");
159 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
162 for ($procline=0; $procline<=$#bodylines; $procline++) {
163 $state eq 'idle' || print "$state ?\n";
164 $lowstate eq 'idle' || print "$lowstate ?\n";
165 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
167 &transcript("Stopping processing here.\n\n");
170 $_= $bodylines[$procline]; s/\s+$//;
172 &transcript("> $_\n");
175 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
176 &transcript("Stopping processing here.\n\n");
178 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
180 &transcript("Debug level $dl.\n\n");
181 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
183 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
184 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
186 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
187 "detailed logs for $gBug#$ref");
188 } elsif (m/^index(\s+full)?$/i) {
189 &transcript("This BTS function is currently disabled, sorry.\n\n");
191 $ok++; # well, it's not really ok, but it fixes #81224 :)
192 } elsif (m/^index-summary\s+by-package$/i) {
193 &transcript("This BTS function is currently disabled, sorry.\n\n");
195 $ok++; # well, it's not really ok, but it fixes #81224 :)
196 } elsif (m/^index-summary(\s+by-number)?$/i) {
197 &transcript("This BTS function is currently disabled, sorry.\n\n");
199 $ok++; # well, it's not really ok, but it fixes #81224 :)
200 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
201 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
202 } elsif (m/^index(\s+|-)maints?$/i) {
203 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
204 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
206 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
207 "$gBug list for maintainer \`$maint'");
209 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
211 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
212 "$gBug list for package $package");
214 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
215 &transcript("This BTS function is currently disabled, sorry.\n\n");
217 $ok++; # well, it's not really ok, but it fixes #81224 :)
218 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
219 &transcript("This BTS function is currently disabled, sorry.\n\n");
221 $ok++; # well, it's not really ok, but it fixes #81224 :)
222 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
223 &transcript("This BTS function is currently disabled, sorry.\n\n");
225 $ok++; # well, it's not really ok, but it fixes #81224 :)
226 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
227 # the following is basically a Debian-specific kludge, but who cares
229 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
230 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
231 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
233 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
234 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
235 &sendinfo("local", "$gConfigDir/$req", "$req file");
237 &transcript("Info file $req does not exist.\n\n");
239 } elsif (m/^help/i) {
243 } elsif (m/^refcard/i) {
244 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
245 } elsif (m/^subscribe/i) {
247 There is no $gProject $gBug mailing list. If you wish to review bug reports
248 please do so via http://$gWebDomain/ or ask this mail server
250 soon: MAILINGLISTS_TEXT
252 } elsif (m/^unsubscribe/i) {
254 soon: UNSUBSCRIBE_TEXT
255 soon: MAILINGLISTS_TEXT
257 } elsif (m/^user\s+(\S+)\s*$/i) {
259 if (Debbugs::User::is_valid_user($newuser)) {
260 my $olduser = ($user ne "" ? " (was $user)" : "");
261 &transcript("Setting user to $newuser$olduser.\n");
265 &transcript("Selected user id ($newuser) invalid, sorry\n");
270 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
273 my $hidden = ($2 ne "");
280 &transcript("No valid user selected\n");
284 if (not $indicated_user and defined $user) {
285 &transcript("User is $user");
288 while (++$procline <= $#bodylines) {
289 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
293 &transcript("> $bodylines[$procline]\n");
295 my ($o, $txt) = ($1, $2);
296 if ($#cats == -1 && $o eq "+") {
297 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
303 unless (ref($cats[-1]) eq "HASH") {
304 $cats[-1] = { "nam" => $cats[-1],
305 "pri" => [], "ttl" => [] };
308 my ($desc, $ord, $op);
309 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
310 $desc = $1; $ord = $3; $op = "";
311 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
312 $desc = $1; $ord = $3; $op = $4;
313 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
314 $desc = ""; $op = $1;
316 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
321 $ord = 999 unless defined $ord;
324 push @{$cats[-1]->{"pri"}}, $prefix . $op;
325 push @{$cats[-1]->{"ttl"}}, $desc;
326 push @ords, "$ord $catsec";
328 @cats[-1]->{"def"} = $desc;
329 push @ords, "$ord DEF";
332 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
333 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
334 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
335 } elsif ($o eq "*") {
338 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
339 $name = $1; $prefix = $3;
341 $name = $txt; $prefix = "";
346 # XXX: got @cats, now do something with it
347 my $u = Debbugs::User::get_user($user);
349 &transcript("Added usercategory $catname.\n\n");
350 $u->{"categories"}->{$catname} = [ @cats ];
352 push @{$u->{visible_cats}},$catname;
355 &transcript("Removed usercategory $catname.\n\n");
356 delete $u->{"categories"}->{$catname};
357 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
360 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
362 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
363 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
364 $ref = $clonebugs{$ref};
367 &transcript("No valid user selected\n");
371 if (not $indicated_user and defined $user) {
372 &transcript("User is $user");
377 Debbugs::User::read_usertags(\%ut, $user);
378 my @oldtags = (); my @newtags = (); my @badtags = ();
380 for my $t (split /[,\s]+/, $tags) {
381 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
388 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
391 for my $t (keys %chtags) {
392 $ut{$t} = [] unless defined $ut{$t};
394 for my $t (keys %ut) {
395 my %res = map { ($_, 1) } @{$ut{$t}};
396 push @oldtags, $t if defined $res{$ref};
397 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
398 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
399 : $addsubcode eq "=");
400 $res{$ref} = 1 if ($addop && defined $chtags{$t});
401 delete $res{$ref} if ($del);
402 push @newtags, $t if defined $res{$ref};
403 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
406 &transcript("There were no usertags set.\n");
408 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
410 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
411 Debbugs::User::write_usertags(\%ut, $user);
413 } elsif (!$control) {
415 Unknown command or malformed arguments to command.
416 (Use control\@$gEmailDomain to manipulate reports.)
420 if (++$unknowns >= 3) {
421 &transcript("Too many unknown commands, stopping here.\n\n");
424 #### "developer only" ones start here
425 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
428 $bug_affected{$ref}=1;
431 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
432 if (length($data->{done}) and not defined($version)) {
433 &transcript("$gBug is already closed, cannot re-close.\n\n");
438 "marked as fixed in version $version" :
440 ", send any further explanations to $data->{originator}";
442 &addmaintainers($data);
443 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
444 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
445 $data->{done}= $replyto;
446 my @keywords= split ' ', $data->{keywords};
447 if (grep $_ eq 'pending', @keywords) {
448 $extramessage= "Removed pending tag.\n";
449 $data->{keywords}= join ' ', grep $_ ne 'pending',
452 addfixedversions($data, $data->{package}, $version, 'binary');
455 From: $gMaintainerEmail ($gProject $gBug Tracking System)
456 To: $data->{originator}
457 Subject: $gBug#$ref acknowledged by developer
459 References: $header{'message-id'} $data->{msgid}
460 In-Reply-To: $data->{msgid}
461 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
462 Reply-To: $ref\@$gEmailDomain
463 X-$gProject-PR-Message: they-closed-control $ref
465 This is an automatic notification regarding your $gBug report
466 #$ref: $data->{subject},
467 which was filed against the $data->{package} package.
469 It has been marked as closed by one of the developers, namely
472 You should be hearing from them with a substantive response shortly,
473 in case you haven't already. If not, please contact them directly.
476 (administrator, $gProject $gBugs database)
479 &sendmailmessage($message,$data->{originator});
480 } while (&getnextbug);
483 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
485 $ref= $1; $newpackage= $2;
486 $bug_affected{$ref}=1;
488 $newpackage =~ y/A-Z/a-z/;
490 if (length($data->{package})) {
491 $action= "$gBug reassigned from package \`$data->{package}'".
492 " to \`$newpackage'.";
494 $action= "$gBug assigned to package \`$newpackage'.";
497 &addmaintainers($data);
498 $data->{package}= $newpackage;
499 $data->{found_versions}= [];
500 $data->{fixed_versions}= [];
501 # TODO: what if $newpackage is a source package?
502 addfoundversions($data, $data->{package}, $version, 'binary');
503 &addmaintainers($data);
504 } while (&getnextbug);
506 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
507 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
508 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
509 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
512 $bug_affected{$ref}=1;
514 if (@{$data->{fixed_versions}}) {
515 &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");
517 if (!length($data->{done})) {
518 &transcript("$gBug is already open, cannot reopen.\n\n");
522 $noriginator eq '' ? "$gBug reopened, originator not changed." :
523 "$gBug reopened, originator set to $noriginator.";
525 &addmaintainers($data);
526 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
527 $data->{fixed_versions}= [];
529 } while (&getnextbug);
532 } elsif (m{^found\s+\#?(-?\d+)
533 (?:\s+(?:$config{package_name_re}\/)?
534 ($config{package_version_re}))?$}ix) {
539 if (!length($data->{done}) and not defined($version)) {
540 &transcript("$gBug is already open, cannot reopen.\n\n");
546 "$gBug marked as found in version $version." :
549 &addmaintainers($data);
550 # The 'done' field gets a bit weird with version
551 # tracking, because a bug may be closed by multiple
552 # people in different branches. Until we have something
553 # more flexible, we set it every time a bug is fixed,
554 # and clear it precisely when a found command is
555 # received for the rightmost fixed-in version, which
556 # equates to the most recent fixing of the bug, or when
557 # a versionless found command is received.
558 if (defined $version) {
559 my $lastfixed = $data->{fixed_versions}[-1];
560 # TODO: what if $data->{package} is a source package?
561 addfoundversions($data, $data->{package}, $version, 'binary');
562 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
566 # Versionless found; assume old-style "not fixed at
568 $data->{fixed_versions} = [];
571 } while (&getnextbug);
574 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
579 $action= "$gBug marked as not found in version $version.";
580 if (length($data->{done})) {
581 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
584 &addmaintainers($data);
585 removefoundversions($data, $data->{package}, $version, 'binary');
586 } while (&getnextbug);
589 elsif (m[^fixed\s+\#?(-?\d+)\s+
590 ((?:$config{package_name_re}\/)?
591 $config{package_version_re})\s*$]ix) {
598 "$gBug marked as fixed in version $version." :
601 &addmaintainers($data);
602 addfixedversions($data, $data->{package}, $version, 'binary');
603 } while (&getnextbug);
606 elsif (m[^notfixed\s+\#?(-?\d+)\s+
607 ((?:$config{package_name_re}\/)?
608 $config{package_version_re})\s*$]ix) {
615 "$gBug marked as not fixed in version $version." :
618 &addmaintainers($data);
619 removefixedversions($data, $data->{package}, $version, 'binary');
620 } while (&getnextbug);
623 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
624 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
627 $bug_affected{$ref}=1;
628 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
629 $ref = $clonebugs{$ref};
632 if (&checkpkglimit) {
634 &addmaintainers($data);
635 $oldsubmitter= $data->{originator};
636 $data->{originator}= $newsubmitter;
637 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
639 &transcript("$action\n");
640 if (length($data->{done})) {
641 &transcript("(By the way, that $gBug is currently marked as done.)\n");
645 From: $gMaintainerEmail ($gProject $gBug Tracking System)
647 Subject: $gBug#$ref submitter address changed
649 References: $header{'message-id'} $data->{msgid}
650 In-Reply-To: $data->{msgid}
651 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
652 Reply-To: $ref\@$gEmailDomain
653 X-$gProject-PR-Message: submitter-changed $ref
655 The submitter address recorded for your $gBug report
656 #$ref: $data->{subject}
659 The old submitter address for this report was
661 The new submitter address is
664 This change was made by
666 If it was incorrect, please contact them directly.
669 (administrator, $gProject $gBugs database)
672 &sendmailmessage($message,$oldsubmitter);
679 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
681 $ref= $1; $whereto= $2;
682 $bug_affected{$ref}=1;
684 if (length($data->{forwarded})) {
685 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
687 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
689 if (length($data->{done})) {
690 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
693 &addmaintainers($data);
694 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
695 &addccaddress("$gForwardList\@$gListDomain");
697 $data->{forwarded}= $whereto;
698 } while (&getnextbug);
700 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
703 $bug_affected{$ref}=1;
705 if (!length($data->{forwarded})) {
706 &transcript("$gBug is not marked as having been forwarded.\n\n");
709 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
711 &addmaintainers($data);
712 $data->{forwarded}= '';
713 } while (&getnextbug);
716 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
717 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
720 $bug_affected{$ref}=1;
722 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
723 &transcript("Severity level \`$newseverity' is not known.\n".
724 "Recognized are: $gShowSeverities.\n\n");
726 } elsif (exists $gObsoleteSeverities{$newseverity}) {
727 &transcript("Severity level \`$newseverity' is obsolete. " .
728 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
731 $printseverity= $data->{severity};
732 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
733 $action= "Severity set to \`$newseverity' from \`$printseverity'";
735 &addmaintainers($data);
736 if (defined $gStrongList and isstrongseverity($newseverity)) {
737 addbcc("$gStrongList\@$gListDomain");
739 $data->{severity}= $newseverity;
740 } while (&getnextbug);
742 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
744 $ref = $1; $addsubcode = $3; $tags = $4;
745 $bug_affected{$ref}=1;
747 if (defined $addsubcode) {
748 $addsub = "sub" if ($addsubcode eq "-");
749 $addsub = "add" if ($addsubcode eq "+");
750 $addsub = "set" if ($addsubcode eq "=");
754 foreach my $t (split /[\s,]+/, $tags) {
755 if (!grep($_ eq $t, @gTags)) {
762 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
763 "Recognized are: ".join(' ', @gTags).".\n\n");
767 if ($data->{keywords} eq '') {
768 &transcript("There were no tags set.\n");
770 &transcript("Tags were: $data->{keywords}\n");
772 if ($addsub eq "set") {
773 $action= "Tags set to: " . join(", ", @okaytags);
774 } elsif ($addsub eq "add") {
775 $action= "Tags added: " . join(", ", @okaytags);
776 } elsif ($addsub eq "sub") {
777 $action= "Tags removed: " . join(", ", @okaytags);
780 &addmaintainers($data);
781 $data->{keywords} = '' if ($addsub eq "set");
782 # Allow removing obsolete tags.
783 if ($addsub eq "sub") {
784 foreach my $t (@badtags) {
785 $data->{keywords} = join ' ', grep $_ ne $t,
786 split ' ', $data->{keywords};
789 # Now process all other additions and subtractions.
790 foreach my $t (@okaytags) {
791 $data->{keywords} = join ' ', grep $_ ne $t,
792 split ' ', $data->{keywords};
793 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
795 $data->{keywords} =~ s/\s*$//;
796 } while (&getnextbug);
798 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
800 my $bugnum = $2; my $blockers = $4;
802 $addsub = "sub" if ($1 eq "un");
803 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
804 $bugnum = $clonebugs{$bugnum};
809 foreach my $b (split /[\s,]+/, $blockers) {
813 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
814 $ref = $clonebugs{$ref};
818 push @okayblockers, $ref;
820 # add to the list all bugs that are merged with $b,
821 # because all of their data must be kept in sync
822 @thisbugmergelist= split(/ /,$data->{mergedwith});
825 foreach $ref (@thisbugmergelist) {
827 push @okayblockers, $ref;
834 push @badblockers, $ref;
838 push @badblockers, $b;
842 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
848 if ($data->{blockedby} eq '') {
849 &transcript("Was not blocked by any bugs.\n");
851 &transcript("Was blocked by: $data->{blockedby}\n");
853 if ($addsub eq "set") {
854 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
855 } elsif ($addsub eq "add") {
856 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
857 } elsif ($addsub eq "sub") {
858 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
863 &addmaintainers($data);
864 my @oldblockerlist = split ' ', $data->{blockedby};
865 $data->{blockedby} = '' if ($addsub eq "set");
866 foreach my $b (@okayblockers) {
867 $data->{blockedby} = manipset($data->{blockedby}, $b,
871 foreach my $b (@oldblockerlist) {
872 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
873 push @{$removedblocks{$b}}, $ref;
876 foreach my $b (split ' ', $data->{blockedby}) {
877 if (! grep { $_ eq $b } @oldblockerlist) {
878 push @{$addedblocks{$b}}, $ref;
881 } while (&getnextbug);
883 # Now that the blockedby data is updated, change blocks data
884 # to match the changes.
885 foreach $ref (keys %addedblocks) {
887 foreach my $b (@{$addedblocks{$ref}}) {
888 $data->{blocks} = manipset($data->{blocks}, $b, 1);
893 foreach $ref (keys %removedblocks) {
895 foreach my $b (@{$removedblocks{$ref}}) {
896 $data->{blocks} = manipset($data->{blocks}, $b, 0);
902 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
904 $ref= $1; $newtitle= $2;
905 $bug_affected{$ref}=1;
906 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
907 $ref = $clonebugs{$ref};
910 if (&checkpkglimit) {
912 &addmaintainers($data);
913 my $oldtitle = $data->{subject};
914 $data->{subject}= $newtitle;
915 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
917 &transcript("$action\n");
918 if (length($data->{done})) {
919 &transcript("(By the way, that $gBug is currently marked as done.)\n");
928 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
931 $bug_affected{$ref} = 1;
933 if (!length($data->{mergedwith})) {
934 &transcript("$gBug is not marked as being merged with any others.\n\n");
937 $mergelowstate eq 'locked' || die "$mergelowstate ?";
938 $action= "Disconnected #$ref from all other report(s).";
939 @newmergelist= split(/ /,$data->{mergedwith});
941 @bug_affected{@newmergelist} = 1 x @newmergelist;
943 &addmaintainers($data);
944 $data->{mergedwith}= ($ref == $discref) ? ''
945 : join(' ',grep($_ ne $ref,@newmergelist));
946 } while (&getnextbug);
949 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
951 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
952 my @newmergelist= ();
957 while (defined($ref= shift(@tomerge))) {
958 &transcript("D| checking merge $ref\n") if $dl;
960 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
961 $ref = $clonebugs{$ref};
963 next if grep($_ == $ref,@newmergelist);
964 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
965 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
967 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
969 &checkmatch('package','m_package',$data->{package},@newmergelist);
970 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
971 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
972 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
973 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
974 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
975 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
976 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
977 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
978 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
979 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
980 if (length($mismatch)) {
981 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
984 &cancelbug; @newmergelist=(); last;
986 push(@newmergelist,$ref);
987 push(@tomerge,split(/ /,$data->{mergedwith}));
991 @newmergelist= sort { $a <=> $b } @newmergelist;
992 $action= "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];
1004 &transcript("$action\n\n");
1007 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1009 my @temp = split /\s+\#?/,$1;
1010 my $master_bug = shift @temp;
1011 my $master_bug_data;
1012 my @tomerge = sort { $a <=> $b } @temp;
1013 unshift @tomerge,$master_bug;
1014 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1015 my @newmergelist= ();
1019 # Here we try to do the right thing.
1020 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1021 # If not, we discard the found and fixed.
1022 # Everything else we set to the values of the first bug.
1024 while (defined($ref= shift(@tomerge))) {
1025 &transcript("D| checking merge $ref\n") if $dl;
1027 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1028 $ref = $clonebugs{$ref};
1030 next if grep($_ == $ref,@newmergelist);
1031 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1032 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1034 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1035 $master_bug_data = $data if not defined $master_bug_data;
1036 if ($data->{package} ne $master_bug_data->{package}) {
1037 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1038 "$gBug $ref is not in the same package as $master_bug\n");
1040 &cancelbug; @newmergelist=(); last;
1042 for my $t (split /\s+/,$data->{keywords}) {
1045 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1046 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1047 push(@newmergelist,$ref);
1048 push(@tomerge,split(/ /,$data->{mergedwith}));
1051 if (@newmergelist) {
1052 @newmergelist= sort { $a <=> $b } @newmergelist;
1053 $action= "Forcibly Merged @newmergelist.";
1054 delete @fixed{keys %found};
1055 for $ref (@newmergelist) {
1056 &getbug || die "huh ? $gBug $ref disappeared during merge";
1057 &addmaintainers($data);
1058 @bug_affected{@newmergelist} = 1 x @newmergelist;
1059 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1060 $data->{keywords}= join(' ', keys %tags);
1061 $data->{found_versions}= [sort keys %found];
1062 $data->{fixed_versions}= [sort keys %fixed];
1063 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1064 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1067 &transcript("$action\n\n");
1070 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1074 @newclonedids = split /\s+/, $2;
1075 $newbugsneeded = scalar(@newclonedids);
1078 $bug_affected{$ref} = 1;
1080 if (length($data->{mergedwith})) {
1081 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1085 &filelock("nextnumber.lock");
1086 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1087 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1088 $firstref= $v+0; $v += $newbugsneeded;
1089 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1092 $lastref = $firstref + $newbugsneeded - 1;
1094 if ($newbugsneeded == 1) {
1095 $action= "$gBug $origref cloned as bug $firstref.";
1097 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1100 my $blocks = $data->{blocks};
1101 my $blockedby = $data->{blockedby};
1104 my $ohash = get_hashname($origref);
1105 my $clone = $firstref;
1106 @bug_affected{@newclonedids} = 1 x @newclonedids;
1107 for $newclonedid (@newclonedids) {
1108 $clonebugs{$newclonedid} = $clone;
1110 my $hash = get_hashname($clone);
1111 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1112 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1113 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1114 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1115 &bughook('new', $clone, $data);
1117 # Update blocking info of bugs blocked by or blocking the
1119 foreach $ref (split ' ', $blocks) {
1121 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1124 foreach $ref (split ' ', $blockedby) {
1126 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1134 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1136 my @pkgs = split /\s+/, $1;
1137 if (scalar(@pkgs) > 0) {
1138 %limit_pkgs = map { ($_, 1) } @pkgs;
1139 &transcript("Ignoring bugs not assigned to: " .
1140 join(" ", keys(%limit_pkgs)) . "\n\n");
1143 &transcript("Not ignoring any bugs.\n\n");
1145 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1146 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1149 $bug_affected{$ref} = 1;
1151 if (length $data->{owner}) {
1152 $action = "Owner changed from $data->{owner} to $newowner.";
1154 $action = "Owner recorded as $newowner.";
1156 if (length $data->{done}) {
1157 $extramessage = "(By the way, this $gBug is currently " .
1158 "marked as done.)\n";
1161 &addmaintainers($data);
1162 $data->{owner} = $newowner;
1163 } while (&getnextbug);
1165 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1168 $bug_affected{$ref} = 1;
1170 if (length $data->{owner}) {
1171 $action = "Removed annotation that $gBug was owned by " .
1174 &addmaintainers($data);
1175 $data->{owner} = '';
1176 } while (&getnextbug);
1178 &transcript("$gBug is not marked as having an owner.\n\n");
1183 &transcript("Unknown command or malformed arguments to command.\n\n");
1185 if (++$unknowns >= 5) {
1186 &transcript("Too many unknown commands, stopping here.\n\n");
1191 if ($procline>$#bodylines) {
1192 &transcript(">\nEnd of message, stopping processing here.\n\n");
1194 if (!$ok && !quickabort) {
1196 &transcript("No commands successfully parsed; sending the help text(s).\n");
1201 &transcript("MC\n") if $dl>1;
1203 for $maint (keys %maintccreasons) {
1204 &transcript("MM|$maint|\n") if $dl>1;
1205 next if $maint eq $replyto;
1207 $reasonsref= $maintccreasons{$maint};
1208 &transcript("MY|$maint|\n") if $dl>2;
1209 for $p (sort keys %$reasonsref) {
1210 &transcript("MP|$p|\n") if $dl>2;
1211 $reasonstring.= ', ' if length($reasonstring);
1212 $reasonstring.= $p.' ' if length($p);
1213 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1215 if (length($reasonstring) > 40) {
1216 (substr $reasonstring, 37) = "...";
1218 $reasonstring = "" if (!defined($reasonstring));
1219 push(@maintccs,"$maint ($reasonstring)");
1220 push(@maintccaddrs,"$maint");
1225 &transcript("MC|@maintccs|\n") if $dl>2;
1226 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1229 # Add Bcc's to subscribed bugs
1230 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1232 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1233 $header{'subject'} = "your mail";
1236 # Error text here advertises how many errors there were
1237 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1240 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1242 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1243 In-Reply-To: $header{'message-id'}
1244 References: $header{'message-id'}
1245 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1247 X-$gProject-PR-Message: transcript
1249 ${transcript}Please contact me if you need assistance.
1252 (administrator, $gProject $gBugs database)
1256 $repliedshow= join(', ',$replyto,@maintccaddrs);
1257 &filelock("lock/-1");
1258 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1260 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1262 "<strong>Request received</strong> from <code>".
1263 html_escape($header{'from'})."</code>\n".
1264 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1266 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1267 close(AP) || &quit("open db-h/-1.log: $!");
1269 utime(time,time,"db-h");
1271 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1273 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1275 sub sendmailmessage {
1276 local ($message,@recips) = @_;
1277 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1278 send_mail_message(message => $message,
1279 recipients => \@recips,
1285 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1286 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1290 #sub unimplemented {
1291 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1295 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1297 if (@newmergelist) {
1298 eval "\$mvarvalue= \$$mvarname";
1299 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1302 "Values for \`$string' don't match:\n".
1303 " #$newmergelist[0] has \`$mvarvalue';\n".
1304 " #$ref has \`$svarvalue'\n"
1305 if $mvarvalue ne $svarvalue;
1307 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1309 eval "\$$mvarname= \$svarvalue";
1314 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1315 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1327 my %h = map { $_ => 1 } split ' ', $list;
1334 return join ' ', sort keys %h;
1337 # High-level bug manipulation calls
1338 # Do announcements themselves
1340 # Possible calling sequences:
1341 # setbug (returns 0)
1343 # setbug (returns 1)
1344 # &transcript(something)
1347 # setbug (returns 1)
1348 # $action= (something)
1350 # (modify s_* variables)
1351 # } while (getnextbug);
1354 &dlen("nochangebug");
1355 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1357 &endmerge if $manybugs;
1359 &dlex("nochangebug");
1363 &dlen("setbug $ref");
1364 if ($ref =~ m/^-\d+/) {
1365 if (!defined $clonebugs{$ref}) {
1367 &dlex("setbug => noclone");
1370 $ref = $clonebugs{$ref};
1372 $state eq 'idle' || die "$state ?";
1375 &dlex("setbug => 0s");
1379 if (!&checkpkglimit) {
1384 @thisbugmergelist= split(/ /,$data->{mergedwith});
1385 if (!@thisbugmergelist) {
1390 &dlex("setbug => 1s");
1399 &dlex("setbug => 0mc");
1403 $state= 'multiple'; $sref=$ref;
1404 &dlex("setbug => 1m");
1409 &dlen("getnextbug");
1410 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1412 if (!$manybugs || !@thisbugmergelist) {
1413 length($action) || die;
1414 &transcript("$action\n$extramessage\n");
1415 &endmerge if $manybugs;
1417 &dlex("getnextbug => 0");
1420 $ref= shift(@thisbugmergelist);
1421 &getbug || die "bug $ref disappeared";
1423 &dlex("getnextbug => 1");
1427 # Low-level bug-manipulation calls
1428 # Do no announcements
1430 # getbug (returns 0)
1432 # getbug (returns 1)
1436 # $action= (something)
1437 # getbug (returns 1)
1439 # getbug (returns 1)
1441 # [getbug (returns 0)]
1442 # &transcript("$action\n\n")
1445 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1446 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1450 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1451 &filelock('lock/merge');
1452 $mergelowstate='locked';
1458 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1460 $mergelowstate='idle';
1465 &dlen("getbug $ref");
1466 $lowstate eq 'idle' || die "$state ?";
1467 if (($data = &lockreadbug($ref))) {
1470 &dlex("getbug => 1");
1475 &dlex("getbug => 0");
1481 $lowstate eq 'open' || die "$state ?";
1488 &dlen("savebug $ref");
1489 $lowstate eq 'open' || die "$lowstate ?";
1490 length($action) || die;
1491 $ref == $sref || die "read $sref but saving $ref ?";
1492 my $hash = get_hashname($ref);
1493 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1496 "<!-- time:".time." -->\n".
1497 "<strong>".html_escape($action)."</strong>\n".
1498 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1499 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1501 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1502 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1503 unlockwritebug($ref, $data);
1510 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1515 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1519 print $_[0] if $debug;
1520 $transcript.= $_[0];
1527 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1528 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1544 sub sendtxthelpraw {
1545 local ($relpath,$description) = @_;
1547 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1548 while(<D>) { $doc.=$_; }
1550 &transcript("Sending $description in separate message.\n");
1551 &sendmailmessage(<<END.$doc,$replyto);
1552 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1554 Subject: $gProject $gBug help: $description
1555 References: $header{'message-id'}
1556 In-Reply-To: $header{'message-id'}
1557 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1559 X-$gProject-PR-Message: doc-text $relpath
1565 sub sendlynxdocraw {
1566 local ($relpath,$description) = @_;
1568 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1569 while(<L>) { $doc.=$_; }
1571 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1572 &transcript("Information ($description) is not available -\n".
1573 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1576 &transcript("Error getting $description (code $? $!):\n$doc\n");
1578 &transcript("Sending $description.\n");
1579 &sendmailmessage(<<END.$doc,$replyto);
1580 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1582 Subject: $gProject $gBugs information: $description
1583 References: $header{'message-id'}
1584 In-Reply-To: $header{'message-id'}
1585 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1587 X-$gProject-PR-Message: doc-html $relpath
1596 $maintccreasons{$cca}{''}{$ref}= 1;
1599 sub addmaintainers {
1600 # Data structure is:
1601 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1604 &ensuremaintainersloaded;
1605 $anymaintfound=0; $anymaintnotfound=0;
1606 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1608 $p =~ /([a-z0-9.+-]+)/;
1610 next unless defined $p;
1611 if (defined $gSubscriptionDomain) {
1612 if (defined($pkgsrc{$p})) {
1613 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1615 addbcc("$p\@$gSubscriptionDomain");
1618 if (defined $data->{severity} and defined $gStrongList and
1619 isstrongseverity($data->{severity})) {
1620 addbcc("$gStrongList\@$gListDomain");
1622 if (defined($maintainerof{$p})) {
1623 $addmaint= $maintainerof{$p};
1624 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1625 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1626 print "maintainer add >$p|$addmaint<\n" if $debug;
1628 print "maintainer none >$p<\n" if $debug;
1629 &transcript("Warning: Unknown package '$p'\n");
1630 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1631 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1635 if (length $data->{owner}) {
1636 $addmaint = $data->{owner};
1637 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1638 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1639 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1643 sub ensuremaintainersloaded {
1645 return if $maintainersloaded++;
1646 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1650 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1651 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1652 $maintainerof{$a}= $2;
1655 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1659 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1660 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1661 $maintainerof{$a}= $2;
1664 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1666 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1667 my ($a, $b) = ($1, $2);
1668 $pkgsrc{lc($a)} = $b;
1674 local ($wherefrom,$path,$description) = @_;
1675 if ($wherefrom eq "ftp.d.o") {
1676 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1678 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1679 &transcript("$description is not available.\n");
1682 &transcript("Error getting $description (code $? $!):\n$doc\n");
1685 } elsif ($wherefrom eq "local") {
1687 $doc = do { local $/; <P> };
1690 &transcript("internal errror: info files location unknown.\n");
1693 &transcript("Sending $description.\n");
1694 &sendmailmessage(<<END.$doc,$replyto);
1695 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1697 Subject: $gProject $gBugs information: $description
1698 References: $header{'message-id'}
1699 In-Reply-To: $header{'message-id'}
1700 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1702 X-$gProject-PR-Message: getinfo
1704 $description follows: