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("|", @gExcludeFromControl) . ")";
147 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
148 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
149 &transcript("Have a nice day\n\n.");
158 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
161 for ($procline=0; $procline<=$#bodylines; $procline++) {
162 $state eq 'idle' || print "$state ?\n";
163 $lowstate eq 'idle' || print "$lowstate ?\n";
164 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
166 &transcript("Stopping processing here.\n\n");
169 $_= $bodylines[$procline]; s/\s+$//;
171 &transcript("> $_\n");
174 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
175 &transcript("Stopping processing here.\n\n");
177 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
179 &transcript("Debug level $dl.\n\n");
180 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
182 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
183 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
185 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
186 "detailed logs for $gBug#$ref");
187 } elsif (m/^index(\s+full)?$/i) {
188 &transcript("This BTS function is currently disabled, sorry.\n\n");
190 $ok++; # well, it's not really ok, but it fixes #81224 :)
191 } elsif (m/^index-summary\s+by-package$/i) {
192 &transcript("This BTS function is currently disabled, sorry.\n\n");
194 $ok++; # well, it's not really ok, but it fixes #81224 :)
195 } elsif (m/^index-summary(\s+by-number)?$/i) {
196 &transcript("This BTS function is currently disabled, sorry.\n\n");
198 $ok++; # well, it's not really ok, but it fixes #81224 :)
199 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
200 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
201 } elsif (m/^index(\s+|-)maints?$/i) {
202 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
203 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
205 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
206 "$gBug list for maintainer \`$maint'");
208 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
210 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
211 "$gBug list for package $package");
213 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
214 &transcript("This BTS function is currently disabled, sorry.\n\n");
216 $ok++; # well, it's not really ok, but it fixes #81224 :)
217 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
218 &transcript("This BTS function is currently disabled, sorry.\n\n");
220 $ok++; # well, it's not really ok, but it fixes #81224 :)
221 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
222 &transcript("This BTS function is currently disabled, sorry.\n\n");
224 $ok++; # well, it's not really ok, but it fixes #81224 :)
225 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
226 # the following is basically a Debian-specific kludge, but who cares
228 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
229 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
230 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
232 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
233 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
234 &sendinfo("local", "$gConfigDir/$req", "$req file");
236 &transcript("Info file $req does not exist.\n\n");
238 } elsif (m/^help/i) {
242 } elsif (m/^refcard/i) {
243 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
244 } elsif (m/^subscribe/i) {
246 There is no $gProject $gBug mailing list. If you wish to review bug reports
247 please do so via http://$gWebDomain/ or ask this mail server
249 soon: MAILINGLISTS_TEXT
251 } elsif (m/^unsubscribe/i) {
253 soon: UNSUBSCRIBE_TEXT
254 soon: MAILINGLISTS_TEXT
256 } elsif (m/^user\s+(\S+)\s*$/i) {
258 if (Debbugs::User::is_valid_user($newuser)) {
259 my $olduser = ($user ne "" ? " (was $user)" : "");
260 &transcript("Setting user to $newuser$olduser.\n");
263 &transcript("Selected user id ($newuser) invalid, sorry\n");
267 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
270 my $hidden = ($2 ne "");
276 while (++$procline <= $#bodylines) {
277 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
281 &transcript("> $bodylines[$procline]\n");
283 my ($o, $txt) = ($1, $2);
284 if ($#cats == -1 && $o eq "+") {
285 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
291 unless (ref($cats[-1]) eq "HASH") {
292 $cats[-1] = { "nam" => $cats[-1],
293 "pri" => [], "ttl" => [] };
296 my ($desc, $ord, $op);
297 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
298 $desc = $1; $ord = $3; $op = "";
299 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
300 $desc = $1; $ord = $3; $op = $4;
301 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
302 $desc = ""; $op = $1;
304 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
309 $ord = 999 unless defined $ord;
312 push @{$cats[-1]->{"pri"}}, $prefix . $op;
313 push @{$cats[-1]->{"ttl"}}, $desc;
314 push @ords, "$ord $catsec";
316 @cats[-1]->{"def"} = $desc;
317 push @ords, "$ord DEF";
320 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
321 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
322 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
323 } elsif ($o eq "*") {
326 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
327 $name = $1; $prefix = $3;
329 $name = $txt; $prefix = "";
334 # XXX: got @cats, now do something with it
335 my $u = Debbugs::User::get_user($user);
337 &transcript("Added usercategory $catname.\n\n");
338 $u->{"categories"}->{$catname} = [ @cats ];
340 push @{$u->{visible_cats}},$catname;
343 &transcript("Removed usercategory $catname.\n\n");
344 delete $u->{"categories"}->{$catname};
345 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
348 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
350 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
351 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
352 $ref = $clonebugs{$ref};
355 &transcript("No valid user selected\n");
360 Debbugs::User::read_usertags(\%ut, $user);
361 my @oldtags = (); my @newtags = (); my @badtags = ();
363 for my $t (split /[,\s]+/, $tags) {
364 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
371 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
374 for my $t (keys %chtags) {
375 $ut{$t} = [] unless defined $ut{$t};
377 for my $t (keys %ut) {
378 my %res = map { ($_, 1) } @{$ut{$t}};
379 push @oldtags, $t if defined $res{$ref};
380 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
381 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
382 : $addsubcode eq "=");
383 $res{$ref} = 1 if ($addop && defined $chtags{$t});
384 delete $res{$ref} if ($del);
385 push @newtags, $t if defined $res{$ref};
386 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
389 &transcript("There were no usertags set.\n");
391 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
393 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
394 Debbugs::User::write_usertags(\%ut, $user);
396 } elsif (!$control) {
398 Unknown command or malformed arguments to command.
399 (Use control\@$gEmailDomain to manipulate reports.)
403 if (++$unknowns >= 3) {
404 &transcript("Too many unknown commands, stopping here.\n\n");
407 #### "developer only" ones start here
408 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
411 $bug_affected{$ref}=1;
414 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
415 if (length($data->{done}) and not defined($version)) {
416 &transcript("$gBug is already closed, cannot re-close.\n\n");
421 "marked as fixed in version $version" :
423 ", send any further explanations to $data->{originator}";
425 &addmaintainers($data);
426 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
427 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
428 $data->{done}= $replyto;
429 my @keywords= split ' ', $data->{keywords};
430 if (grep $_ eq 'pending', @keywords) {
431 $extramessage= "Removed pending tag.\n";
432 $data->{keywords}= join ' ', grep $_ ne 'pending',
435 addfixedversions($data, $data->{package}, $version, 'binary');
438 From: $gMaintainerEmail ($gProject $gBug Tracking System)
439 To: $data->{originator}
440 Subject: $gBug#$ref acknowledged by developer
442 References: $header{'message-id'} $data->{msgid}
443 In-Reply-To: $data->{msgid}
444 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
445 Reply-To: $ref\@$gEmailDomain
446 X-$gProject-PR-Message: they-closed-control $ref
448 This is an automatic notification regarding your $gBug report
449 #$ref: $data->{subject},
450 which was filed against the $data->{package} package.
452 It has been marked as closed by one of the developers, namely
455 You should be hearing from them with a substantive response shortly,
456 in case you haven't already. If not, please contact them directly.
459 (administrator, $gProject $gBugs database)
462 &sendmailmessage($message,$data->{originator});
463 } while (&getnextbug);
466 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
468 $ref= $1; $newpackage= $2;
469 $bug_affected{$ref}=1;
471 $newpackage =~ y/A-Z/a-z/;
473 if (length($data->{package})) {
474 $action= "$gBug reassigned from package \`$data->{package}'".
475 " to \`$newpackage'.";
477 $action= "$gBug assigned to package \`$newpackage'.";
480 &addmaintainers($data);
481 $data->{package}= $newpackage;
482 $data->{found_versions}= [];
483 $data->{fixed_versions}= [];
484 # TODO: what if $newpackage is a source package?
485 addfoundversions($data, $data->{package}, $version, 'binary');
486 &addmaintainers($data);
487 } while (&getnextbug);
489 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
490 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
491 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
492 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
495 $bug_affected{$ref}=1;
497 if (@{$data->{fixed_versions}}) {
498 &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");
500 if (!length($data->{done})) {
501 &transcript("$gBug is already open, cannot reopen.\n\n");
505 $noriginator eq '' ? "$gBug reopened, originator not changed." :
506 "$gBug reopened, originator set to $noriginator.";
508 &addmaintainers($data);
509 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
510 $data->{fixed_versions}= [];
512 } while (&getnextbug);
515 } elsif (m{^found\s+\#?(-?\d+)
516 (?:\s+(?:$config{package_name_re}\/)?
517 ($config{package_version_re}))?$}ix) {
522 if (!length($data->{done}) and not defined($version)) {
523 &transcript("$gBug is already open, cannot reopen.\n\n");
529 "$gBug marked as found in version $version." :
532 &addmaintainers($data);
533 # The 'done' field gets a bit weird with version
534 # tracking, because a bug may be closed by multiple
535 # people in different branches. Until we have something
536 # more flexible, we set it every time a bug is fixed,
537 # and clear it precisely when a found command is
538 # received for the rightmost fixed-in version, which
539 # equates to the most recent fixing of the bug, or when
540 # a versionless found command is received.
541 if (defined $version) {
542 my $lastfixed = $data->{fixed_versions}[-1];
543 # TODO: what if $data->{package} is a source package?
544 addfoundversions($data, $data->{package}, $version, 'binary');
545 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
549 # Versionless found; assume old-style "not fixed at
551 $data->{fixed_versions} = [];
554 } while (&getnextbug);
557 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
562 $action= "$gBug marked as not found in version $version.";
563 if (length($data->{done})) {
564 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
567 &addmaintainers($data);
568 removefoundversions($data, $data->{package}, $version, 'binary');
569 } while (&getnextbug);
572 elsif (m[^fixed\s+\#?(-?\d+)\s+
573 ((?:$config{package_name_re}\/)?
574 $config{package_version_re})\s*$]ix) {
581 "$gBug marked as fixed in version $version." :
584 &addmaintainers($data);
585 addfixedversions($data, $data->{package}, $version, 'binary');
586 } while (&getnextbug);
589 elsif (m[^notfixed\s+\#?(-?\d+)\s+
590 ((?:$config{package_name_re}\/)?
591 $config{package_version_re})\s*$]ix) {
598 "$gBug marked as not fixed in version $version." :
601 &addmaintainers($data);
602 removefixedversions($data, $data->{package}, $version, 'binary');
603 } while (&getnextbug);
606 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
607 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
610 $bug_affected{$ref}=1;
611 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
612 $ref = $clonebugs{$ref};
615 if (&checkpkglimit) {
617 &addmaintainers($data);
618 $oldsubmitter= $data->{originator};
619 $data->{originator}= $newsubmitter;
620 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
622 &transcript("$action\n");
623 if (length($data->{done})) {
624 &transcript("(By the way, that $gBug is currently marked as done.)\n");
628 From: $gMaintainerEmail ($gProject $gBug Tracking System)
630 Subject: $gBug#$ref submitter address changed
632 References: $header{'message-id'} $data->{msgid}
633 In-Reply-To: $data->{msgid}
634 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
635 Reply-To: $ref\@$gEmailDomain
636 X-$gProject-PR-Message: submitter-changed $ref
638 The submitter address recorded for your $gBug report
639 #$ref: $data->{subject}
642 The old submitter address for this report was
644 The new submitter address is
647 This change was made by
649 If it was incorrect, please contact them directly.
652 (administrator, $gProject $gBugs database)
655 &sendmailmessage($message,$oldsubmitter);
662 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
664 $ref= $1; $whereto= $2;
665 $bug_affected{$ref}=1;
667 if (length($data->{forwarded})) {
668 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
670 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
672 if (length($data->{done})) {
673 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
676 &addmaintainers($data);
677 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
678 &addccaddress("$gForwardList\@$gListDomain");
680 $data->{forwarded}= $whereto;
681 } while (&getnextbug);
683 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
686 $bug_affected{$ref}=1;
688 if (!length($data->{forwarded})) {
689 &transcript("$gBug is not marked as having been forwarded.\n\n");
692 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
694 &addmaintainers($data);
695 $data->{forwarded}= '';
696 } while (&getnextbug);
699 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
700 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
703 $bug_affected{$ref}=1;
705 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
706 &transcript("Severity level \`$newseverity' is not known.\n".
707 "Recognized are: $gShowSeverities.\n\n");
709 } elsif (exists $gObsoleteSeverities{$newseverity}) {
710 &transcript("Severity level \`$newseverity' is obsolete. " .
711 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
714 $printseverity= $data->{severity};
715 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
716 $action= "Severity set to \`$newseverity' from \`$printseverity'";
718 &addmaintainers($data);
719 if (defined $gStrongList and isstrongseverity($newseverity)) {
720 addbcc("$gStrongList\@$gListDomain");
722 $data->{severity}= $newseverity;
723 } while (&getnextbug);
725 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
727 $ref = $1; $addsubcode = $3; $tags = $4;
728 $bug_affected{$ref}=1;
730 if (defined $addsubcode) {
731 $addsub = "sub" if ($addsubcode eq "-");
732 $addsub = "add" if ($addsubcode eq "+");
733 $addsub = "set" if ($addsubcode eq "=");
737 foreach my $t (split /[\s,]+/, $tags) {
738 if (!grep($_ eq $t, @gTags)) {
745 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
746 "Recognized are: ".join(' ', @gTags).".\n\n");
750 if ($data->{keywords} eq '') {
751 &transcript("There were no tags set.\n");
753 &transcript("Tags were: $data->{keywords}\n");
755 if ($addsub eq "set") {
756 $action= "Tags set to: " . join(", ", @okaytags);
757 } elsif ($addsub eq "add") {
758 $action= "Tags added: " . join(", ", @okaytags);
759 } elsif ($addsub eq "sub") {
760 $action= "Tags removed: " . join(", ", @okaytags);
763 &addmaintainers($data);
764 $data->{keywords} = '' if ($addsub eq "set");
765 # Allow removing obsolete tags.
766 if ($addsub eq "sub") {
767 foreach my $t (@badtags) {
768 $data->{keywords} = join ' ', grep $_ ne $t,
769 split ' ', $data->{keywords};
772 # Now process all other additions and subtractions.
773 foreach my $t (@okaytags) {
774 $data->{keywords} = join ' ', grep $_ ne $t,
775 split ' ', $data->{keywords};
776 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
778 $data->{keywords} =~ s/\s*$//;
779 } while (&getnextbug);
781 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
783 my $bugnum = $2; my $blockers = $4;
785 $addsub = "sub" if ($1 eq "un");
786 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
787 $bugnum = $clonebugs{$bugnum};
792 foreach my $b (split /[\s,]+/, $blockers) {
796 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
797 $ref = $clonebugs{$ref};
801 push @okayblockers, $ref;
803 # add to the list all bugs that are merged with $b,
804 # because all of their data must be kept in sync
805 @thisbugmergelist= split(/ /,$data->{mergedwith});
808 foreach $ref (@thisbugmergelist) {
810 push @okayblockers, $ref;
817 push @badblockers, $ref;
821 push @badblockers, $b;
825 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
831 if ($data->{blockedby} eq '') {
832 &transcript("Was not blocked by any bugs.\n");
834 &transcript("Was blocked by: $data->{blockedby}\n");
836 if ($addsub eq "set") {
837 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
838 } elsif ($addsub eq "add") {
839 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
840 } elsif ($addsub eq "sub") {
841 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
846 &addmaintainers($data);
847 my @oldblockerlist = split ' ', $data->{blockedby};
848 $data->{blockedby} = '' if ($addsub eq "set");
849 foreach my $b (@okayblockers) {
850 $data->{blockedby} = manipset($data->{blockedby}, $b,
854 foreach my $b (@oldblockerlist) {
855 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
856 push @{$removedblocks{$b}}, $ref;
859 foreach my $b (split ' ', $data->{blockedby}) {
860 if (! grep { $_ eq $b } @oldblockerlist) {
861 push @{$addedblocks{$b}}, $ref;
864 } while (&getnextbug);
866 # Now that the blockedby data is updated, change blocks data
867 # to match the changes.
868 foreach $ref (keys %addedblocks) {
870 foreach my $b (@{$addedblocks{$ref}}) {
871 $data->{blocks} = manipset($data->{blocks}, $b, 1);
876 foreach $ref (keys %removedblocks) {
878 foreach my $b (@{$removedblocks{$ref}}) {
879 $data->{blocks} = manipset($data->{blocks}, $b, 0);
885 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
887 $ref= $1; $newtitle= $2;
888 $bug_affected{$ref}=1;
889 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
890 $ref = $clonebugs{$ref};
893 if (&checkpkglimit) {
895 &addmaintainers($data);
896 my $oldtitle = $data->{subject};
897 $data->{subject}= $newtitle;
898 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
900 &transcript("$action\n");
901 if (length($data->{done})) {
902 &transcript("(By the way, that $gBug is currently marked as done.)\n");
911 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
914 $bug_affected{$ref} = 1;
916 if (!length($data->{mergedwith})) {
917 &transcript("$gBug is not marked as being merged with any others.\n\n");
920 $mergelowstate eq 'locked' || die "$mergelowstate ?";
921 $action= "Disconnected #$ref from all other report(s).";
922 @newmergelist= split(/ /,$data->{mergedwith});
924 @bug_affected{@newmergelist} = 1 x @newmergelist;
926 &addmaintainers($data);
927 $data->{mergedwith}= ($ref == $discref) ? ''
928 : join(' ',grep($_ ne $ref,@newmergelist));
929 } while (&getnextbug);
932 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
934 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
935 my @newmergelist= ();
940 while (defined($ref= shift(@tomerge))) {
941 &transcript("D| checking merge $ref\n") if $dl;
943 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
944 $ref = $clonebugs{$ref};
946 next if grep($_ == $ref,@newmergelist);
947 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
948 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
950 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
952 &checkmatch('package','m_package',$data->{package},@newmergelist);
953 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
954 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
955 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
956 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
957 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
958 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
959 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
960 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
961 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
962 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
963 if (length($mismatch)) {
964 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
967 &cancelbug; @newmergelist=(); last;
969 push(@newmergelist,$ref);
970 push(@tomerge,split(/ /,$data->{mergedwith}));
974 @newmergelist= sort { $a <=> $b } @newmergelist;
975 $action= "Merged @newmergelist.";
976 delete @fixed{keys %found};
977 for $ref (@newmergelist) {
978 &getbug || die "huh ? $gBug $ref disappeared during merge";
979 &addmaintainers($data);
980 @bug_affected{@newmergelist} = 1 x @newmergelist;
981 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
982 $data->{keywords}= join(' ', keys %tags);
983 $data->{found_versions}= [sort keys %found];
984 $data->{fixed_versions}= [sort keys %fixed];
987 &transcript("$action\n\n");
990 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
992 my @temp = split /\s+\#?/,$1;
993 my $master_bug = shift @temp;
995 my @tomerge = sort { $a <=> $b } @temp;
996 unshift @tomerge,$master_bug;
997 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
998 my @newmergelist= ();
1002 # Here we try to do the right thing.
1003 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1004 # If not, we discard the found and fixed.
1005 # Everything else we set to the values of the first bug.
1007 while (defined($ref= shift(@tomerge))) {
1008 &transcript("D| checking merge $ref\n") if $dl;
1010 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1011 $ref = $clonebugs{$ref};
1013 next if grep($_ == $ref,@newmergelist);
1014 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1015 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1017 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1018 $master_bug_data = $data if not defined $master_bug_data;
1019 if ($data->{package} ne $master_bug_data->{package}) {
1020 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1021 "$gBug $ref is not in the same package as $master_bug\n");
1023 &cancelbug; @newmergelist=(); last;
1025 for my $t (split /\s+/,$data->{keywords}) {
1028 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1029 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1030 push(@newmergelist,$ref);
1031 push(@tomerge,split(/ /,$data->{mergedwith}));
1034 if (@newmergelist) {
1035 @newmergelist= sort { $a <=> $b } @newmergelist;
1036 $action= "Forcibly Merged @newmergelist.";
1037 delete @fixed{keys %found};
1038 for $ref (@newmergelist) {
1039 &getbug || die "huh ? $gBug $ref disappeared during merge";
1040 &addmaintainers($data);
1041 @bug_affected{@newmergelist} = 1 x @newmergelist;
1042 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1043 $data->{keywords}= join(' ', keys %tags);
1044 $data->{found_versions}= [sort keys %found];
1045 $data->{fixed_versions}= [sort keys %fixed];
1046 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1047 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1050 &transcript("$action\n\n");
1053 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1057 @newclonedids = split /\s+/, $2;
1058 $newbugsneeded = scalar(@newclonedids);
1061 $bug_affected{$ref} = 1;
1063 if (length($data->{mergedwith})) {
1064 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1068 &filelock("nextnumber.lock");
1069 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1070 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1071 $firstref= $v+0; $v += $newbugsneeded;
1072 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1075 $lastref = $firstref + $newbugsneeded - 1;
1077 if ($newbugsneeded == 1) {
1078 $action= "$gBug $origref cloned as bug $firstref.";
1080 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1083 my $blocks = $data->{blocks};
1084 my $blockedby = $data->{blockedby};
1087 my $ohash = get_hashname($origref);
1088 my $clone = $firstref;
1089 @bug_affected{@newclonedids} = 1 x @newclonedids;
1090 for $newclonedid (@newclonedids) {
1091 $clonebugs{$newclonedid} = $clone;
1093 my $hash = get_hashname($clone);
1094 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1095 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1096 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1097 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1098 &bughook('new', $clone, $data);
1100 # Update blocking info of bugs blocked by or blocking the
1102 foreach $ref (split ' ', $blocks) {
1104 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1107 foreach $ref (split ' ', $blockedby) {
1109 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1117 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1119 my @pkgs = split /\s+/, $1;
1120 if (scalar(@pkgs) > 0) {
1121 %limit_pkgs = map { ($_, 1) } @pkgs;
1122 &transcript("Ignoring bugs not assigned to: " .
1123 join(" ", keys(%limit_pkgs)) . "\n\n");
1126 &transcript("Not ignoring any bugs.\n\n");
1128 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1129 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1132 $bug_affected{$ref} = 1;
1134 if (length $data->{owner}) {
1135 $action = "Owner changed from $data->{owner} to $newowner.";
1137 $action = "Owner recorded as $newowner.";
1139 if (length $data->{done}) {
1140 $extramessage = "(By the way, this $gBug is currently " .
1141 "marked as done.)\n";
1144 &addmaintainers($data);
1145 $data->{owner} = $newowner;
1146 } while (&getnextbug);
1148 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1151 $bug_affected{$ref} = 1;
1153 if (length $data->{owner}) {
1154 $action = "Removed annotation that $gBug was owned by " .
1157 &addmaintainers($data);
1158 $data->{owner} = '';
1159 } while (&getnextbug);
1161 &transcript("$gBug is not marked as having an owner.\n\n");
1166 &transcript("Unknown command or malformed arguments to command.\n\n");
1168 if (++$unknowns >= 5) {
1169 &transcript("Too many unknown commands, stopping here.\n\n");
1174 if ($procline>$#bodylines) {
1175 &transcript(">\nEnd of message, stopping processing here.\n\n");
1177 if (!$ok && !quickabort) {
1179 &transcript("No commands successfully parsed; sending the help text(s).\n");
1184 &transcript("MC\n") if $dl>1;
1186 for $maint (keys %maintccreasons) {
1187 &transcript("MM|$maint|\n") if $dl>1;
1188 next if $maint eq $replyto;
1190 $reasonsref= $maintccreasons{$maint};
1191 &transcript("MY|$maint|\n") if $dl>2;
1192 for $p (sort keys %$reasonsref) {
1193 &transcript("MP|$p|\n") if $dl>2;
1194 $reasonstring.= ', ' if length($reasonstring);
1195 $reasonstring.= $p.' ' if length($p);
1196 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1198 if (length($reasonstring) > 40) {
1199 (substr $reasonstring, 37) = "...";
1201 $reasonstring = "" if (!defined($reasonstring));
1202 push(@maintccs,"$maint ($reasonstring)");
1203 push(@maintccaddrs,"$maint");
1208 &transcript("MC|@maintccs|\n") if $dl>2;
1209 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1212 # Add Bcc's to subscribed bugs
1213 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1215 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1216 $header{'subject'} = "your mail";
1219 # Error text here advertises how many errors there were
1220 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1223 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1225 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1226 In-Reply-To: $header{'message-id'}
1227 References: $header{'message-id'}
1228 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1230 X-$gProject-PR-Message: transcript
1232 ${transcript}Please contact me if you need assistance.
1235 (administrator, $gProject $gBugs database)
1239 $repliedshow= join(', ',$replyto,@maintccaddrs);
1240 &filelock("lock/-1");
1241 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1243 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1245 "<strong>Request received</strong> from <code>".
1246 html_escape($header{'from'})."</code>\n".
1247 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1249 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1250 close(AP) || &quit("open db-h/-1.log: $!");
1252 utime(time,time,"db-h");
1254 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1256 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1258 sub sendmailmessage {
1259 local ($message,@recips) = @_;
1260 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1261 send_mail_message(message => $message,
1262 recipients => \@recips,
1268 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1269 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1273 #sub unimplemented {
1274 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1278 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1280 if (@newmergelist) {
1281 eval "\$mvarvalue= \$$mvarname";
1282 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1285 "Values for \`$string' don't match:\n".
1286 " #$newmergelist[0] has \`$mvarvalue';\n".
1287 " #$ref has \`$svarvalue'\n"
1288 if $mvarvalue ne $svarvalue;
1290 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1292 eval "\$$mvarname= \$svarvalue";
1297 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1298 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1310 my %h = map { $_ => 1 } split ' ', $list;
1317 return join ' ', sort keys %h;
1320 # High-level bug manipulation calls
1321 # Do announcements themselves
1323 # Possible calling sequences:
1324 # setbug (returns 0)
1326 # setbug (returns 1)
1327 # &transcript(something)
1330 # setbug (returns 1)
1331 # $action= (something)
1333 # (modify s_* variables)
1334 # } while (getnextbug);
1337 &dlen("nochangebug");
1338 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1340 &endmerge if $manybugs;
1342 &dlex("nochangebug");
1346 &dlen("setbug $ref");
1347 if ($ref =~ m/^-\d+/) {
1348 if (!defined $clonebugs{$ref}) {
1350 &dlex("setbug => noclone");
1353 $ref = $clonebugs{$ref};
1355 $state eq 'idle' || die "$state ?";
1358 &dlex("setbug => 0s");
1362 if (!&checkpkglimit) {
1367 @thisbugmergelist= split(/ /,$data->{mergedwith});
1368 if (!@thisbugmergelist) {
1373 &dlex("setbug => 1s");
1382 &dlex("setbug => 0mc");
1386 $state= 'multiple'; $sref=$ref;
1387 &dlex("setbug => 1m");
1392 &dlen("getnextbug");
1393 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1395 if (!$manybugs || !@thisbugmergelist) {
1396 length($action) || die;
1397 &transcript("$action\n$extramessage\n");
1398 &endmerge if $manybugs;
1400 &dlex("getnextbug => 0");
1403 $ref= shift(@thisbugmergelist);
1404 &getbug || die "bug $ref disappeared";
1406 &dlex("getnextbug => 1");
1410 # Low-level bug-manipulation calls
1411 # Do no announcements
1413 # getbug (returns 0)
1415 # getbug (returns 1)
1419 # $action= (something)
1420 # getbug (returns 1)
1422 # getbug (returns 1)
1424 # [getbug (returns 0)]
1425 # &transcript("$action\n\n")
1428 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1429 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1433 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1434 &filelock('lock/merge');
1435 $mergelowstate='locked';
1441 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1443 $mergelowstate='idle';
1448 &dlen("getbug $ref");
1449 $lowstate eq 'idle' || die "$state ?";
1450 if (($data = &lockreadbug($ref))) {
1453 &dlex("getbug => 1");
1458 &dlex("getbug => 0");
1464 $lowstate eq 'open' || die "$state ?";
1471 &dlen("savebug $ref");
1472 $lowstate eq 'open' || die "$lowstate ?";
1473 length($action) || die;
1474 $ref == $sref || die "read $sref but saving $ref ?";
1475 my $hash = get_hashname($ref);
1476 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1479 "<!-- time:".time." -->\n".
1480 "<strong>".html_escape($action)."</strong>\n".
1481 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1482 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1484 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1485 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1486 unlockwritebug($ref, $data);
1493 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1498 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1502 print $_[0] if $debug;
1503 $transcript.= $_[0];
1510 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1511 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1527 sub sendtxthelpraw {
1528 local ($relpath,$description) = @_;
1530 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1531 while(<D>) { $doc.=$_; }
1533 &transcript("Sending $description in separate message.\n");
1534 &sendmailmessage(<<END.$doc,$replyto);
1535 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1537 Subject: $gProject $gBug help: $description
1538 References: $header{'message-id'}
1539 In-Reply-To: $header{'message-id'}
1540 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1542 X-$gProject-PR-Message: doc-text $relpath
1548 sub sendlynxdocraw {
1549 local ($relpath,$description) = @_;
1551 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1552 while(<L>) { $doc.=$_; }
1554 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1555 &transcript("Information ($description) is not available -\n".
1556 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1559 &transcript("Error getting $description (code $? $!):\n$doc\n");
1561 &transcript("Sending $description.\n");
1562 &sendmailmessage(<<END.$doc,$replyto);
1563 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1565 Subject: $gProject $gBugs information: $description
1566 References: $header{'message-id'}
1567 In-Reply-To: $header{'message-id'}
1568 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1570 X-$gProject-PR-Message: doc-html $relpath
1579 $maintccreasons{$cca}{''}{$ref}= 1;
1582 sub addmaintainers {
1583 # Data structure is:
1584 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1587 &ensuremaintainersloaded;
1588 $anymaintfound=0; $anymaintnotfound=0;
1589 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1591 $p =~ /([a-z0-9.+-]+)/;
1593 next unless defined $p;
1594 if (defined $gSubscriptionDomain) {
1595 if (defined($pkgsrc{$p})) {
1596 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1598 addbcc("$p\@$gSubscriptionDomain");
1601 if (defined $data->{severity} and defined $gStrongList and
1602 isstrongseverity($data->{severity})) {
1603 addbcc("$gStrongList\@$gListDomain");
1605 if (defined($maintainerof{$p})) {
1606 $addmaint= $maintainerof{$p};
1607 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1608 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1609 print "maintainer add >$p|$addmaint<\n" if $debug;
1611 print "maintainer none >$p<\n" if $debug;
1612 &transcript("Warning: Unknown package '$p'\n");
1613 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1614 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1618 if (length $data->{owner}) {
1619 $addmaint = $data->{owner};
1620 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1621 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1622 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1626 sub ensuremaintainersloaded {
1628 return if $maintainersloaded++;
1629 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1633 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1634 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1635 $maintainerof{$a}= $2;
1638 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1642 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1643 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1644 $maintainerof{$a}= $2;
1647 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1649 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1650 my ($a, $b) = ($1, $2);
1651 $pkgsrc{lc($a)} = $b;
1657 local ($wherefrom,$path,$description) = @_;
1658 if ($wherefrom eq "ftp.d.o") {
1659 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1661 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1662 &transcript("$description is not available.\n");
1665 &transcript("Error getting $description (code $? $!):\n$doc\n");
1668 } elsif ($wherefrom eq "local") {
1670 $doc = do { local $/; <P> };
1673 &transcript("internal errror: info files location unknown.\n");
1676 &transcript("Sending $description.\n");
1677 &sendmailmessage(<<END.$doc,$replyto);
1678 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1680 Subject: $gProject $gBugs information: $description
1681 References: $header{'message-id'}
1682 In-Reply-To: $header{'message-id'}
1683 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1685 X-$gProject-PR-Message: getinfo
1687 $description follows: