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 ];
339 $u->{visible_cats}{$catname} = $hidden;
341 &transcript("Removed usercategory $catname.\n\n");
342 delete $u->{"categories"}->{$catname};
343 delete $u->{visible_cats}{$catname};
346 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
348 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
349 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
350 $ref = $clonebugs{$ref};
353 &transcript("No valid user selected\n");
358 Debbugs::User::read_usertags(\%ut, $user);
359 my @oldtags = (); my @newtags = (); my @badtags = ();
361 for my $t (split /[,\s]+/, $tags) {
362 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
369 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
372 for my $t (keys %chtags) {
373 $ut{$t} = [] unless defined $ut{$t};
375 for my $t (keys %ut) {
376 my %res = map { ($_, 1) } @{$ut{$t}};
377 push @oldtags, $t if defined $res{$ref};
378 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
379 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
380 : $addsubcode eq "=");
381 $res{$ref} = 1 if ($addop && defined $chtags{$t});
382 delete $res{$ref} if ($del);
383 push @newtags, $t if defined $res{$ref};
384 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
387 &transcript("There were no usertags set.\n");
389 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
391 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
392 Debbugs::User::write_usertags(\%ut, $user);
394 } elsif (!$control) {
396 Unknown command or malformed arguments to command.
397 (Use control\@$gEmailDomain to manipulate reports.)
401 if (++$unknowns >= 3) {
402 &transcript("Too many unknown commands, stopping here.\n\n");
405 #### "developer only" ones start here
406 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
409 $bug_affected{$ref}=1;
412 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
413 if (length($data->{done}) and not defined($version)) {
414 &transcript("$gBug is already closed, cannot re-close.\n\n");
419 "marked as fixed in version $version" :
421 ", send any further explanations to $data->{originator}";
423 &addmaintainers($data);
424 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
425 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
426 $data->{done}= $replyto;
427 my @keywords= split ' ', $data->{keywords};
428 if (grep $_ eq 'pending', @keywords) {
429 $extramessage= "Removed pending tag.\n";
430 $data->{keywords}= join ' ', grep $_ ne 'pending',
433 addfixedversions($data, $data->{package}, $version, 'binary');
436 From: $gMaintainerEmail ($gProject $gBug Tracking System)
437 To: $data->{originator}
438 Subject: $gBug#$ref acknowledged by developer
440 References: $header{'message-id'} $data->{msgid}
441 In-Reply-To: $data->{msgid}
442 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
443 Reply-To: $ref\@$gEmailDomain
444 X-$gProject-PR-Message: they-closed-control $ref
446 This is an automatic notification regarding your $gBug report
447 #$ref: $data->{subject},
448 which was filed against the $data->{package} package.
450 It has been marked as closed by one of the developers, namely
453 You should be hearing from them with a substantive response shortly,
454 in case you haven't already. If not, please contact them directly.
457 (administrator, $gProject $gBugs database)
460 &sendmailmessage($message,$data->{originator});
461 } while (&getnextbug);
464 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
466 $ref= $1; $newpackage= $2;
467 $bug_affected{$ref}=1;
469 $newpackage =~ y/A-Z/a-z/;
471 if (length($data->{package})) {
472 $action= "$gBug reassigned from package \`$data->{package}'".
473 " to \`$newpackage'.";
475 $action= "$gBug assigned to package \`$newpackage'.";
478 &addmaintainers($data);
479 $data->{package}= $newpackage;
480 $data->{found_versions}= [];
481 $data->{fixed_versions}= [];
482 # TODO: what if $newpackage is a source package?
483 addfoundversions($data, $data->{package}, $version, 'binary');
484 &addmaintainers($data);
485 } while (&getnextbug);
487 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
488 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
489 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
490 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
493 $bug_affected{$ref}=1;
495 if (@{$data->{fixed_versions}}) {
496 &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");
498 if (!length($data->{done})) {
499 &transcript("$gBug is already open, cannot reopen.\n\n");
503 $noriginator eq '' ? "$gBug reopened, originator not changed." :
504 "$gBug reopened, originator set to $noriginator.";
506 &addmaintainers($data);
507 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
508 $data->{fixed_versions}= [];
510 } while (&getnextbug);
513 } elsif (m{^found\s+\#?(-?\d+)
514 (?:\s+(?:$config{package_name_re}\/)?
515 ($config{package_version_re}))?$}ix) {
520 if (!length($data->{done}) and not defined($version)) {
521 &transcript("$gBug is already open, cannot reopen.\n\n");
527 "$gBug marked as found in version $version." :
530 &addmaintainers($data);
531 # The 'done' field gets a bit weird with version
532 # tracking, because a bug may be closed by multiple
533 # people in different branches. Until we have something
534 # more flexible, we set it every time a bug is fixed,
535 # and clear it precisely when a found command is
536 # received for the rightmost fixed-in version, which
537 # equates to the most recent fixing of the bug, or when
538 # a versionless found command is received.
539 if (defined $version) {
540 my $lastfixed = $data->{fixed_versions}[-1];
541 # TODO: what if $data->{package} is a source package?
542 addfoundversions($data, $data->{package}, $version, 'binary');
543 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
547 # Versionless found; assume old-style "not fixed at
549 $data->{fixed_versions} = [];
552 } while (&getnextbug);
555 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
560 $action= "$gBug marked as not found in version $version.";
561 if (length($data->{done})) {
562 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
565 &addmaintainers($data);
566 removefoundversions($data, $data->{package}, $version, 'binary');
567 } while (&getnextbug);
570 elsif (m[^fixed\s+\#?(-?\d+)\s+
571 ((?:$config{package_name_re}\/)?
572 $config{package_version_re})\s*$]ix) {
579 "$gBug marked as fixed in version $version." :
582 &addmaintainers($data);
583 addfixedversions($data, $data->{package}, $version, 'binary');
584 } while (&getnextbug);
587 elsif (m[^notfixed\s+\#?(-?\d+)\s+
588 ((?:$config{package_name_re}\/)?
589 $config{package_version_re})\s*$]ix) {
596 "$gBug marked as not fixed in version $version." :
599 &addmaintainers($data);
600 removefixedversions($data, $data->{package}, $version, 'binary');
601 } while (&getnextbug);
604 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
605 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
608 $bug_affected{$ref}=1;
609 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
610 $ref = $clonebugs{$ref};
613 if (&checkpkglimit) {
615 &addmaintainers($data);
616 $oldsubmitter= $data->{originator};
617 $data->{originator}= $newsubmitter;
618 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
620 &transcript("$action\n");
621 if (length($data->{done})) {
622 &transcript("(By the way, that $gBug is currently marked as done.)\n");
626 From: $gMaintainerEmail ($gProject $gBug Tracking System)
628 Subject: $gBug#$ref submitter address changed
630 References: $header{'message-id'} $data->{msgid}
631 In-Reply-To: $data->{msgid}
632 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
633 Reply-To: $ref\@$gEmailDomain
634 X-$gProject-PR-Message: submitter-changed $ref
636 The submitter address recorded for your $gBug report
637 #$ref: $data->{subject}
640 The old submitter address for this report was
642 The new submitter address is
645 This change was made by
647 If it was incorrect, please contact them directly.
650 (administrator, $gProject $gBugs database)
653 &sendmailmessage($message,$oldsubmitter);
660 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
662 $ref= $1; $whereto= $2;
663 $bug_affected{$ref}=1;
665 if (length($data->{forwarded})) {
666 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
668 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
670 if (length($data->{done})) {
671 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
674 &addmaintainers($data);
675 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
676 &addccaddress("$gForwardList\@$gListDomain");
678 $data->{forwarded}= $whereto;
679 } while (&getnextbug);
681 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
684 $bug_affected{$ref}=1;
686 if (!length($data->{forwarded})) {
687 &transcript("$gBug is not marked as having been forwarded.\n\n");
690 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
692 &addmaintainers($data);
693 $data->{forwarded}= '';
694 } while (&getnextbug);
697 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
698 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
701 $bug_affected{$ref}=1;
703 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
704 &transcript("Severity level \`$newseverity' is not known.\n".
705 "Recognized are: $gShowSeverities.\n\n");
707 } elsif (exists $gObsoleteSeverities{$newseverity}) {
708 &transcript("Severity level \`$newseverity' is obsolete. " .
709 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
712 $printseverity= $data->{severity};
713 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
714 $action= "Severity set to \`$newseverity' from \`$printseverity'";
716 &addmaintainers($data);
717 if (defined $gStrongList and isstrongseverity($newseverity)) {
718 addbcc("$gStrongList\@$gListDomain");
720 $data->{severity}= $newseverity;
721 } while (&getnextbug);
723 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
725 $ref = $1; $addsubcode = $3; $tags = $4;
726 $bug_affected{$ref}=1;
728 if (defined $addsubcode) {
729 $addsub = "sub" if ($addsubcode eq "-");
730 $addsub = "add" if ($addsubcode eq "+");
731 $addsub = "set" if ($addsubcode eq "=");
735 foreach my $t (split /[\s,]+/, $tags) {
736 if (!grep($_ eq $t, @gTags)) {
743 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
744 "Recognized are: ".join(' ', @gTags).".\n\n");
748 if ($data->{keywords} eq '') {
749 &transcript("There were no tags set.\n");
751 &transcript("Tags were: $data->{keywords}\n");
753 if ($addsub eq "set") {
754 $action= "Tags set to: " . join(", ", @okaytags);
755 } elsif ($addsub eq "add") {
756 $action= "Tags added: " . join(", ", @okaytags);
757 } elsif ($addsub eq "sub") {
758 $action= "Tags removed: " . join(", ", @okaytags);
761 &addmaintainers($data);
762 $data->{keywords} = '' if ($addsub eq "set");
763 # Allow removing obsolete tags.
764 if ($addsub eq "sub") {
765 foreach my $t (@badtags) {
766 $data->{keywords} = join ' ', grep $_ ne $t,
767 split ' ', $data->{keywords};
770 # Now process all other additions and subtractions.
771 foreach my $t (@okaytags) {
772 $data->{keywords} = join ' ', grep $_ ne $t,
773 split ' ', $data->{keywords};
774 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
776 $data->{keywords} =~ s/\s*$//;
777 } while (&getnextbug);
779 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
781 my $bugnum = $2; my $blockers = $4;
783 $addsub = "sub" if ($1 eq "un");
784 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
785 $bugnum = $clonebugs{$bugnum};
790 foreach my $b (split /[\s,]+/, $blockers) {
794 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
795 $ref = $clonebugs{$ref};
799 push @okayblockers, $ref;
801 # add to the list all bugs that are merged with $b,
802 # because all of their data must be kept in sync
803 @thisbugmergelist= split(/ /,$data->{mergedwith});
806 foreach $ref (@thisbugmergelist) {
808 push @okayblockers, $ref;
815 push @badblockers, $ref;
819 push @badblockers, $b;
823 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
829 if ($data->{blockedby} eq '') {
830 &transcript("Was not blocked by any bugs.\n");
832 &transcript("Was blocked by: $data->{blockedby}\n");
834 if ($addsub eq "set") {
835 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
836 } elsif ($addsub eq "add") {
837 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
838 } elsif ($addsub eq "sub") {
839 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
844 &addmaintainers($data);
845 my @oldblockerlist = split ' ', $data->{blockedby};
846 $data->{blockedby} = '' if ($addsub eq "set");
847 foreach my $b (@okayblockers) {
848 $data->{blockedby} = manipset($data->{blockedby}, $b,
852 foreach my $b (@oldblockerlist) {
853 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
854 push @{$removedblocks{$b}}, $ref;
857 foreach my $b (split ' ', $data->{blockedby}) {
858 if (! grep { $_ eq $b } @oldblockerlist) {
859 push @{$addedblocks{$b}}, $ref;
862 } while (&getnextbug);
864 # Now that the blockedby data is updated, change blocks data
865 # to match the changes.
866 foreach $ref (keys %addedblocks) {
868 foreach my $b (@{$addedblocks{$ref}}) {
869 $data->{blocks} = manipset($data->{blocks}, $b, 1);
874 foreach $ref (keys %removedblocks) {
876 foreach my $b (@{$removedblocks{$ref}}) {
877 $data->{blocks} = manipset($data->{blocks}, $b, 0);
883 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
885 $ref= $1; $newtitle= $2;
886 $bug_affected{$ref}=1;
887 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
888 $ref = $clonebugs{$ref};
891 if (&checkpkglimit) {
893 &addmaintainers($data);
894 my $oldtitle = $data->{subject};
895 $data->{subject}= $newtitle;
896 $action= "Changed $gBug title to $newtitle from $oldtitle.";
898 &transcript("$action\n");
899 if (length($data->{done})) {
900 &transcript("(By the way, that $gBug is currently marked as done.)\n");
909 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
912 $bug_affected{$ref} = 1;
914 if (!length($data->{mergedwith})) {
915 &transcript("$gBug is not marked as being merged with any others.\n\n");
918 $mergelowstate eq 'locked' || die "$mergelowstate ?";
919 $action= "Disconnected #$ref from all other report(s).";
920 @newmergelist= split(/ /,$data->{mergedwith});
922 @bug_affected{@newmergelist} = 1 x @newmergelist;
924 &addmaintainers($data);
925 $data->{mergedwith}= ($ref == $discref) ? ''
926 : join(' ',grep($_ ne $ref,@newmergelist));
927 } while (&getnextbug);
930 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
932 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
933 my @newmergelist= ();
938 while (defined($ref= shift(@tomerge))) {
939 &transcript("D| checking merge $ref\n") if $dl;
941 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
942 $ref = $clonebugs{$ref};
944 next if grep($_ == $ref,@newmergelist);
945 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
946 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
948 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
950 &checkmatch('package','m_package',$data->{package},@newmergelist);
951 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
952 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
953 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
954 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
955 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
956 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
957 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
958 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
959 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
960 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
961 if (length($mismatch)) {
962 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
965 &cancelbug; @newmergelist=(); last;
967 push(@newmergelist,$ref);
968 push(@tomerge,split(/ /,$data->{mergedwith}));
972 @newmergelist= sort { $a <=> $b } @newmergelist;
973 $action= "Merged @newmergelist.";
974 delete @fixed{keys %found};
975 for $ref (@newmergelist) {
976 &getbug || die "huh ? $gBug $ref disappeared during merge";
977 &addmaintainers($data);
978 @bug_affected{@newmergelist} = 1 x @newmergelist;
979 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
980 $data->{keywords}= join(' ', keys %tags);
981 $data->{found_versions}= [sort keys %found];
982 $data->{fixed_versions}= [sort keys %fixed];
985 &transcript("$action\n\n");
988 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
990 my @temp = split /\s+\#?/,$1;
991 my $master_bug = shift @temp;
993 my @tomerge = sort { $a <=> $b } @temp;
994 unshift @tomerge,$master_bug;
995 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
996 my @newmergelist= ();
1000 # Here we try to do the right thing.
1001 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1002 # If not, we discard the found and fixed.
1003 # Everything else we set to the values of the first bug.
1005 while (defined($ref= shift(@tomerge))) {
1006 &transcript("D| checking merge $ref\n") if $dl;
1008 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1009 $ref = $clonebugs{$ref};
1011 next if grep($_ == $ref,@newmergelist);
1012 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1013 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1015 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1016 $master_bug_data = $data if not defined $master_bug_data;
1017 if ($data->{package} ne $master_bug_data->{package}) {
1018 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1019 "$gBug $ref is not in the same package as $master_bug\n");
1021 &cancelbug; @newmergelist=(); last;
1023 for my $t (split /\s+/,$data->{keywords}) {
1026 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1027 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1028 push(@newmergelist,$ref);
1029 push(@tomerge,split(/ /,$data->{mergedwith}));
1032 if (@newmergelist) {
1033 @newmergelist= sort { $a <=> $b } @newmergelist;
1034 $action= "Forcibly Merged @newmergelist.";
1035 delete @fixed{keys %found};
1036 for $ref (@newmergelist) {
1037 &getbug || die "huh ? $gBug $ref disappeared during merge";
1038 &addmaintainers($data);
1039 @bug_affected{@newmergelist} = 1 x @newmergelist;
1040 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1041 $data->{keywords}= join(' ', keys %tags);
1042 $data->{found_versions}= [sort keys %found];
1043 $data->{fixed_versions}= [sort keys %fixed];
1044 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1045 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1048 &transcript("$action\n\n");
1051 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1055 @newclonedids = split /\s+/, $2;
1056 $newbugsneeded = scalar(@newclonedids);
1059 $bug_affected{$ref} = 1;
1061 if (length($data->{mergedwith})) {
1062 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1066 &filelock("nextnumber.lock");
1067 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1068 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1069 $firstref= $v+0; $v += $newbugsneeded;
1070 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1073 $lastref = $firstref + $newbugsneeded - 1;
1075 if ($newbugsneeded == 1) {
1076 $action= "$gBug $origref cloned as bug $firstref.";
1078 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1081 my $blocks = $data->{blocks};
1082 my $blockedby = $data->{blockedby};
1085 my $ohash = get_hashname($origref);
1086 my $clone = $firstref;
1087 @bug_affected{@newclonedids} = 1 x @newclonedids;
1088 for $newclonedid (@newclonedids) {
1089 $clonebugs{$newclonedid} = $clone;
1091 my $hash = get_hashname($clone);
1092 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1093 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1094 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1095 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1096 &bughook('new', $clone, $data);
1098 # Update blocking info of bugs blocked by or blocking the
1100 foreach $ref (split ' ', $blocks) {
1102 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1105 foreach $ref (split ' ', $blockedby) {
1107 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1115 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1117 my @pkgs = split /\s+/, $1;
1118 if (scalar(@pkgs) > 0) {
1119 %limit_pkgs = map { ($_, 1) } @pkgs;
1120 &transcript("Ignoring bugs not assigned to: " .
1121 join(" ", keys(%limit_pkgs)) . "\n\n");
1124 &transcript("Not ignoring any bugs.\n\n");
1126 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1127 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1130 $bug_affected{$ref} = 1;
1132 if (length $data->{owner}) {
1133 $action = "Owner changed from $data->{owner} to $newowner.";
1135 $action = "Owner recorded as $newowner.";
1137 if (length $data->{done}) {
1138 $extramessage = "(By the way, this $gBug is currently " .
1139 "marked as done.)\n";
1142 &addmaintainers($data);
1143 $data->{owner} = $newowner;
1144 } while (&getnextbug);
1146 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1149 $bug_affected{$ref} = 1;
1151 if (length $data->{owner}) {
1152 $action = "Removed annotation that $gBug was owned by " .
1155 &addmaintainers($data);
1156 $data->{owner} = '';
1157 } while (&getnextbug);
1159 &transcript("$gBug is not marked as having an owner.\n\n");
1164 &transcript("Unknown command or malformed arguments to command.\n\n");
1166 if (++$unknowns >= 5) {
1167 &transcript("Too many unknown commands, stopping here.\n\n");
1172 if ($procline>$#bodylines) {
1173 &transcript(">\nEnd of message, stopping processing here.\n\n");
1175 if (!$ok && !quickabort) {
1177 &transcript("No commands successfully parsed; sending the help text(s).\n");
1182 &transcript("MC\n") if $dl>1;
1184 for $maint (keys %maintccreasons) {
1185 &transcript("MM|$maint|\n") if $dl>1;
1186 next if $maint eq $replyto;
1188 $reasonsref= $maintccreasons{$maint};
1189 &transcript("MY|$maint|\n") if $dl>2;
1190 for $p (sort keys %$reasonsref) {
1191 &transcript("MP|$p|\n") if $dl>2;
1192 $reasonstring.= ', ' if length($reasonstring);
1193 $reasonstring.= $p.' ' if length($p);
1194 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1196 if (length($reasonstring) > 40) {
1197 (substr $reasonstring, 37) = "...";
1199 $reasonstring = "" if (!defined($reasonstring));
1200 push(@maintccs,"$maint ($reasonstring)");
1201 push(@maintccaddrs,"$maint");
1206 &transcript("MC|@maintccs|\n") if $dl>2;
1207 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1210 # Add Bcc's to subscribed bugs
1211 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1213 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1214 $header{'subject'} = "your mail";
1217 # Error text here advertises how many errors there were
1218 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1221 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1223 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1224 In-Reply-To: $header{'message-id'}
1225 References: $header{'message-id'}
1226 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1228 X-$gProject-PR-Message: transcript
1230 ${transcript}Please contact me if you need assistance.
1233 (administrator, $gProject $gBugs database)
1237 $repliedshow= join(', ',$replyto,@maintccaddrs);
1238 &filelock("lock/-1");
1239 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1241 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1243 "<strong>Request received</strong> from <code>".
1244 html_escape($header{'from'})."</code>\n".
1245 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1247 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1248 close(AP) || &quit("open db-h/-1.log: $!");
1250 utime(time,time,"db-h");
1252 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1254 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1256 sub sendmailmessage {
1257 local ($message,@recips) = @_;
1258 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1259 send_mail_message(message => $message,
1260 recipients => \@recips,
1266 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1267 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1271 #sub unimplemented {
1272 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1276 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1278 if (@newmergelist) {
1279 eval "\$mvarvalue= \$$mvarname";
1280 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1283 "Values for \`$string' don't match:\n".
1284 " #$newmergelist[0] has \`$mvarvalue';\n".
1285 " #$ref has \`$svarvalue'\n"
1286 if $mvarvalue ne $svarvalue;
1288 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1290 eval "\$$mvarname= \$svarvalue";
1295 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1296 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1308 my %h = map { $_ => 1 } split ' ', $list;
1315 return join ' ', sort keys %h;
1318 # High-level bug manipulation calls
1319 # Do announcements themselves
1321 # Possible calling sequences:
1322 # setbug (returns 0)
1324 # setbug (returns 1)
1325 # &transcript(something)
1328 # setbug (returns 1)
1329 # $action= (something)
1331 # (modify s_* variables)
1332 # } while (getnextbug);
1335 &dlen("nochangebug");
1336 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1338 &endmerge if $manybugs;
1340 &dlex("nochangebug");
1344 &dlen("setbug $ref");
1345 if ($ref =~ m/^-\d+/) {
1346 if (!defined $clonebugs{$ref}) {
1348 &dlex("setbug => noclone");
1351 $ref = $clonebugs{$ref};
1353 $state eq 'idle' || die "$state ?";
1356 &dlex("setbug => 0s");
1360 if (!&checkpkglimit) {
1365 @thisbugmergelist= split(/ /,$data->{mergedwith});
1366 if (!@thisbugmergelist) {
1371 &dlex("setbug => 1s");
1380 &dlex("setbug => 0mc");
1384 $state= 'multiple'; $sref=$ref;
1385 &dlex("setbug => 1m");
1390 &dlen("getnextbug");
1391 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1393 if (!$manybugs || !@thisbugmergelist) {
1394 length($action) || die;
1395 &transcript("$action\n$extramessage\n");
1396 &endmerge if $manybugs;
1398 &dlex("getnextbug => 0");
1401 $ref= shift(@thisbugmergelist);
1402 &getbug || die "bug $ref disappeared";
1404 &dlex("getnextbug => 1");
1408 # Low-level bug-manipulation calls
1409 # Do no announcements
1411 # getbug (returns 0)
1413 # getbug (returns 1)
1417 # $action= (something)
1418 # getbug (returns 1)
1420 # getbug (returns 1)
1422 # [getbug (returns 0)]
1423 # &transcript("$action\n\n")
1426 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1427 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1431 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1432 &filelock('lock/merge');
1433 $mergelowstate='locked';
1439 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1441 $mergelowstate='idle';
1446 &dlen("getbug $ref");
1447 $lowstate eq 'idle' || die "$state ?";
1448 if (($data = &lockreadbug($ref))) {
1451 &dlex("getbug => 1");
1456 &dlex("getbug => 0");
1462 $lowstate eq 'open' || die "$state ?";
1469 &dlen("savebug $ref");
1470 $lowstate eq 'open' || die "$lowstate ?";
1471 length($action) || die;
1472 $ref == $sref || die "read $sref but saving $ref ?";
1473 my $hash = get_hashname($ref);
1474 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1477 "<!-- time:".time." -->\n".
1478 "<strong>".html_escape($action)."</strong>\n".
1479 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1480 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1482 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1483 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1484 unlockwritebug($ref, $data);
1491 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1496 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1500 print $_[0] if $debug;
1501 $transcript.= $_[0];
1508 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1509 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1525 sub sendtxthelpraw {
1526 local ($relpath,$description) = @_;
1528 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1529 while(<D>) { $doc.=$_; }
1531 &transcript("Sending $description in separate message.\n");
1532 &sendmailmessage(<<END.$doc,$replyto);
1533 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1535 Subject: $gProject $gBug help: $description
1536 References: $header{'message-id'}
1537 In-Reply-To: $header{'message-id'}
1538 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1540 X-$gProject-PR-Message: doc-text $relpath
1546 sub sendlynxdocraw {
1547 local ($relpath,$description) = @_;
1549 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1550 while(<L>) { $doc.=$_; }
1552 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1553 &transcript("Information ($description) is not available -\n".
1554 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1557 &transcript("Error getting $description (code $? $!):\n$doc\n");
1559 &transcript("Sending $description.\n");
1560 &sendmailmessage(<<END.$doc,$replyto);
1561 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1563 Subject: $gProject $gBugs information: $description
1564 References: $header{'message-id'}
1565 In-Reply-To: $header{'message-id'}
1566 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1568 X-$gProject-PR-Message: doc-html $relpath
1577 $maintccreasons{$cca}{''}{$ref}= 1;
1580 sub addmaintainers {
1581 # Data structure is:
1582 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1585 &ensuremaintainersloaded;
1586 $anymaintfound=0; $anymaintnotfound=0;
1587 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1589 $p =~ /([a-z0-9.+-]+)/;
1591 next unless defined $p;
1592 if (defined $gSubscriptionDomain) {
1593 if (defined($pkgsrc{$p})) {
1594 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1596 addbcc("$p\@$gSubscriptionDomain");
1599 if (defined $data->{severity} and defined $gStrongList and
1600 isstrongseverity($data->{severity})) {
1601 addbcc("$gStrongList\@$gListDomain");
1603 if (defined($maintainerof{$p})) {
1604 $addmaint= $maintainerof{$p};
1605 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1606 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1607 print "maintainer add >$p|$addmaint<\n" if $debug;
1609 print "maintainer none >$p<\n" if $debug;
1610 &transcript("Warning: Unknown package '$p'\n");
1611 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1612 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1616 if (length $data->{owner}) {
1617 $addmaint = $data->{owner};
1618 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1619 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1620 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1624 sub ensuremaintainersloaded {
1626 return if $maintainersloaded++;
1627 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1631 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1632 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1633 $maintainerof{$a}= $2;
1636 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1640 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1641 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1642 $maintainerof{$a}= $2;
1645 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1647 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1648 my ($a, $b) = ($1, $2);
1649 $pkgsrc{lc($a)} = $b;
1655 local ($wherefrom,$path,$description) = @_;
1656 if ($wherefrom eq "ftp.d.o") {
1657 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1659 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1660 &transcript("$description is not available.\n");
1663 &transcript("Error getting $description (code $? $!):\n$doc\n");
1666 } elsif ($wherefrom eq "local") {
1668 $doc = do { local $/; <P> };
1671 &transcript("internal errror: info files location unknown.\n");
1674 &transcript("Sending $description.\n");
1675 &sendmailmessage(<<END.$doc,$replyto);
1676 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1678 Subject: $gProject $gBugs information: $description
1679 References: $header{'message-id'}
1680 In-Reply-To: $header{'message-id'}
1681 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1683 X-$gProject-PR-Message: getinfo
1685 $description follows: