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 use Debbugs::Control qw(:archive :log);
17 use Debbugs::Log qw(:misc);
19 $lib_path = $gLibPath;
20 require "$lib_path/errorlib";
21 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
23 chdir("$gSpoolDir") || die "chdir spool: $!\n";
26 open DEBUG, ">/dev/null";
31 m/^[RC]\.\d+$/ || &quit("bad argument");
34 if (!rename("incoming/G$nn","incoming/P$nn")) {
35 $_=$!.''; m/no such file or directory/i && exit 0;
36 &quit("renaming to lock: $!");
39 open(M,"incoming/P$nn");
46 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
48 my $parser = new MIME::Parser;
49 mkdir "$gSpoolDir/mime.tmp", 0777;
50 $parser->output_under("$gSpoolDir/mime.tmp");
51 my $entity = eval { $parser->parse_data(join('',@log)) };
53 # header and decoded body respectively
54 my (@headerlines, @bodylines);
55 # Bug numbers to send e-mail to, hash so that we don't send to the
59 if ($entity and $entity->head->tags) {
60 @headerlines = @{$entity->head->header};
63 my $entity_body = getmailbody($entity);
64 @bodylines = $entity_body ? $entity_body->as_lines() : ();
67 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
69 for ($i = 0; $i <= $#msg; $i++) {
71 last unless length($_);
72 while ($msg[$i+1] =~ m/^\s/) {
76 push @headerlines, $_;
79 @bodylines = @msg[$i..$#msg];
83 $_ = decode_rfc1522($_);
85 print ">$_<\n" if $debug;
88 print ">$v=$_<\n" if $debug;
91 print "!>$_<\n" if $debug;
95 # Strip off RFC2440-style PGP clearsigning.
96 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
97 shift @bodylines while @bodylines and length $bodylines[0];
98 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
99 for my $findsig (0 .. $#bodylines) {
100 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
101 $#bodylines = $findsig - 1;
105 map { s/^- // } @bodylines;
108 grep(s/\s+$//,@bodylines);
110 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
112 if (defined $header{'resent-from'} && !defined $header{'from'}) {
113 $header{'from'} = $header{'resent-from'};
116 defined($header{'from'}) || &quit("no From header");
118 delete $header{'reply-to'}
119 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
121 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
122 $replyto = $header{'reply-to'};
124 $replyto = $header{'from'};
127 # This is an error counter which should be incremented every time there is an error.
129 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
131 &transcript("Processing commands for $controlrequestaddr:\n\n");
136 $mergelowstate= 'idle';
142 $user =~ s/^.*<(.*)>.*$/$1/;
143 $user =~ s/[(].*[)]//;
144 $user =~ s/^\s*(\S+)\s+.*$/$1/;
145 $user = "" unless (Debbugs::User::is_valid_user($user));
146 my $indicated_user = 0;
150 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
151 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
152 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
153 &transcript("Have a nice day\n\n.");
162 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
165 for ($procline=0; $procline<=$#bodylines; $procline++) {
166 $state eq 'idle' || print "$state ?\n";
167 $lowstate eq 'idle' || print "$lowstate ?\n";
168 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
170 &transcript("Stopping processing here.\n\n");
173 $_= $bodylines[$procline]; s/\s+$//;
175 &transcript("> $_\n");
178 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
179 &transcript("Stopping processing here.\n\n");
181 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
183 &transcript("Debug level $dl.\n\n");
184 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
186 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
187 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
189 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
190 "detailed logs for $gBug#$ref");
191 } elsif (m/^index(\s+full)?$/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-package$/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-summary(\s+by-number)?$/i) {
200 &transcript("This BTS function is currently disabled, sorry.\n\n");
202 $ok++; # well, it's not really ok, but it fixes #81224 :)
203 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
204 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
205 } elsif (m/^index(\s+|-)maints?$/i) {
206 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
207 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
209 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
210 "$gBug list for maintainer \`$maint'");
212 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
214 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
215 "$gBug list for package $package");
217 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/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+(last|-1)$/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/^send-unmatched\s+(old|-2)$/i) {
226 &transcript("This BTS function is currently disabled, sorry.\n\n");
228 $ok++; # well, it's not really ok, but it fixes #81224 :)
229 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
230 # the following is basically a Debian-specific kludge, but who cares
232 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
233 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
234 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
236 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
237 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
238 &sendinfo("local", "$gConfigDir/$req", "$req file");
240 &transcript("Info file $req does not exist.\n\n");
242 } elsif (m/^help/i) {
246 } elsif (m/^refcard/i) {
247 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
248 } elsif (m/^subscribe/i) {
250 There is no $gProject $gBug mailing list. If you wish to review bug reports
251 please do so via http://$gWebDomain/ or ask this mail server
253 soon: MAILINGLISTS_TEXT
255 } elsif (m/^unsubscribe/i) {
257 soon: UNSUBSCRIBE_TEXT
258 soon: MAILINGLISTS_TEXT
260 } elsif (m/^user\s+(\S+)\s*$/i) {
262 if (Debbugs::User::is_valid_user($newuser)) {
263 my $olduser = ($user ne "" ? " (was $user)" : "");
264 &transcript("Setting user to $newuser$olduser.\n");
268 &transcript("Selected user id ($newuser) invalid, sorry\n");
273 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
276 my $hidden = ($2 ne "");
283 &transcript("No valid user selected\n");
287 if (not $indicated_user and defined $user) {
288 &transcript("User is $user");
291 while (++$procline <= $#bodylines) {
292 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
296 &transcript("> $bodylines[$procline]\n");
298 my ($o, $txt) = ($1, $2);
299 if ($#cats == -1 && $o eq "+") {
300 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
306 unless (ref($cats[-1]) eq "HASH") {
307 $cats[-1] = { "nam" => $cats[-1],
308 "pri" => [], "ttl" => [] };
311 my ($desc, $ord, $op);
312 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
313 $desc = $1; $ord = $3; $op = "";
314 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
315 $desc = $1; $ord = $3; $op = $4;
316 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
317 $desc = ""; $op = $1;
319 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
324 $ord = 999 unless defined $ord;
327 push @{$cats[-1]->{"pri"}}, $prefix . $op;
328 push @{$cats[-1]->{"ttl"}}, $desc;
329 push @ords, "$ord $catsec";
331 @cats[-1]->{"def"} = $desc;
332 push @ords, "$ord DEF";
335 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
336 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
337 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
338 } elsif ($o eq "*") {
341 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
342 $name = $1; $prefix = $3;
344 $name = $txt; $prefix = "";
349 # XXX: got @cats, now do something with it
350 my $u = Debbugs::User::get_user($user);
352 &transcript("Added usercategory $catname.\n\n");
353 $u->{"categories"}->{$catname} = [ @cats ];
355 push @{$u->{visible_cats}},$catname;
358 &transcript("Removed usercategory $catname.\n\n");
359 delete $u->{"categories"}->{$catname};
360 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
363 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
365 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
366 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
367 $ref = $clonebugs{$ref};
370 &transcript("No valid user selected\n");
374 if (not $indicated_user and defined $user) {
375 &transcript("User is $user");
380 Debbugs::User::read_usertags(\%ut, $user);
381 my @oldtags = (); my @newtags = (); my @badtags = ();
383 for my $t (split /[,\s]+/, $tags) {
384 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
391 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
394 for my $t (keys %chtags) {
395 $ut{$t} = [] unless defined $ut{$t};
397 for my $t (keys %ut) {
398 my %res = map { ($_, 1) } @{$ut{$t}};
399 push @oldtags, $t if defined $res{$ref};
400 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
401 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
402 : $addsubcode eq "=");
403 $res{$ref} = 1 if ($addop && defined $chtags{$t});
404 delete $res{$ref} if ($del);
405 push @newtags, $t if defined $res{$ref};
406 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
409 &transcript("There were no usertags set.\n");
411 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
413 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
414 Debbugs::User::write_usertags(\%ut, $user);
416 } elsif (!$control) {
418 Unknown command or malformed arguments to command.
419 (Use control\@$gEmailDomain to manipulate reports.)
423 if (++$unknowns >= 3) {
424 &transcript("Too many unknown commands, stopping here.\n\n");
427 #### "developer only" ones start here
428 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
431 $bug_affected{$ref}=1;
434 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
435 if (length($data->{done}) and not defined($version)) {
436 &transcript("$gBug is already closed, cannot re-close.\n\n");
441 "marked as fixed in version $version" :
443 ", send any further explanations to $data->{originator}";
445 &addmaintainers($data);
446 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
447 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
448 $data->{done}= $replyto;
449 my @keywords= split ' ', $data->{keywords};
450 if (grep $_ eq 'pending', @keywords) {
451 $extramessage= "Removed pending tag.\n";
452 $data->{keywords}= join ' ', grep $_ ne 'pending',
455 addfixedversions($data, $data->{package}, $version, 'binary');
458 From: $gMaintainerEmail ($gProject $gBug Tracking System)
459 To: $data->{originator}
460 Subject: $gBug#$ref acknowledged by developer
462 References: $header{'message-id'} $data->{msgid}
463 In-Reply-To: $data->{msgid}
464 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
465 Reply-To: $ref\@$gEmailDomain
466 X-$gProject-PR-Message: they-closed-control $ref
468 This is an automatic notification regarding your $gBug report
469 #$ref: $data->{subject},
470 which was filed against the $data->{package} package.
472 It has been marked as closed by one of the developers, namely
475 You should be hearing from them with a substantive response shortly,
476 in case you haven't already. If not, please contact them directly.
479 (administrator, $gProject $gBugs database)
482 &sendmailmessage($message,$data->{originator});
483 } while (&getnextbug);
486 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
488 $ref= $1; $newpackage= $2;
489 $bug_affected{$ref}=1;
491 $newpackage =~ y/A-Z/a-z/;
493 if (length($data->{package})) {
494 $action= "$gBug reassigned from package \`$data->{package}'".
495 " to \`$newpackage'.";
497 $action= "$gBug assigned to package \`$newpackage'.";
500 &addmaintainers($data);
501 $data->{package}= $newpackage;
502 $data->{found_versions}= [];
503 $data->{fixed_versions}= [];
504 # TODO: what if $newpackage is a source package?
505 addfoundversions($data, $data->{package}, $version, 'binary');
506 &addmaintainers($data);
507 } while (&getnextbug);
509 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
510 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
511 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
512 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
515 $bug_affected{$ref}=1;
517 if (@{$data->{fixed_versions}}) {
518 &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");
520 if (!length($data->{done})) {
521 &transcript("$gBug is already open, cannot reopen.\n\n");
525 $noriginator eq '' ? "$gBug reopened, originator not changed." :
526 "$gBug reopened, originator set to $noriginator.";
528 &addmaintainers($data);
529 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
530 $data->{fixed_versions}= [];
532 } while (&getnextbug);
535 } elsif (m{^found\s+\#?(-?\d+)
536 (?:\s+(?:$config{package_name_re}\/)?
537 ($config{package_version_re}))?$}ix) {
542 if (!length($data->{done}) and not defined($version)) {
543 &transcript("$gBug is already open, cannot reopen.\n\n");
549 "$gBug marked as found in version $version." :
552 &addmaintainers($data);
553 # The 'done' field gets a bit weird with version
554 # tracking, because a bug may be closed by multiple
555 # people in different branches. Until we have something
556 # more flexible, we set it every time a bug is fixed,
557 # and clear it precisely when a found command is
558 # received for the rightmost fixed-in version, which
559 # equates to the most recent fixing of the bug, or when
560 # a versionless found command is received.
561 if (defined $version) {
562 my $lastfixed = $data->{fixed_versions}[-1];
563 # TODO: what if $data->{package} is a source package?
564 addfoundversions($data, $data->{package}, $version, 'binary');
565 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
569 # Versionless found; assume old-style "not fixed at
571 $data->{fixed_versions} = [];
574 } while (&getnextbug);
577 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
582 $action= "$gBug marked as not found in version $version.";
583 if (length($data->{done})) {
584 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
587 &addmaintainers($data);
588 removefoundversions($data, $data->{package}, $version, 'binary');
589 } while (&getnextbug);
592 elsif (m[^fixed\s+\#?(-?\d+)\s+
593 ((?:$config{package_name_re}\/)?
594 $config{package_version_re})\s*$]ix) {
601 "$gBug marked as fixed in version $version." :
604 &addmaintainers($data);
605 addfixedversions($data, $data->{package}, $version, 'binary');
606 } while (&getnextbug);
609 elsif (m[^notfixed\s+\#?(-?\d+)\s+
610 ((?:$config{package_name_re}\/)?
611 $config{package_version_re})\s*$]ix) {
618 "$gBug marked as not fixed in version $version." :
621 &addmaintainers($data);
622 removefixedversions($data, $data->{package}, $version, 'binary');
623 } while (&getnextbug);
626 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
627 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
630 $bug_affected{$ref}=1;
631 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
632 $ref = $clonebugs{$ref};
635 if (&checkpkglimit) {
637 &addmaintainers($data);
638 $oldsubmitter= $data->{originator};
639 $data->{originator}= $newsubmitter;
640 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
642 &transcript("$action\n");
643 if (length($data->{done})) {
644 &transcript("(By the way, that $gBug is currently marked as done.)\n");
648 From: $gMaintainerEmail ($gProject $gBug Tracking System)
650 Subject: $gBug#$ref submitter address changed
652 References: $header{'message-id'} $data->{msgid}
653 In-Reply-To: $data->{msgid}
654 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
655 Reply-To: $ref\@$gEmailDomain
656 X-$gProject-PR-Message: submitter-changed $ref
658 The submitter address recorded for your $gBug report
659 #$ref: $data->{subject}
662 The old submitter address for this report was
664 The new submitter address is
667 This change was made by
669 If it was incorrect, please contact them directly.
672 (administrator, $gProject $gBugs database)
675 &sendmailmessage($message,$oldsubmitter);
682 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
684 $ref= $1; $whereto= $2;
685 $bug_affected{$ref}=1;
687 if (length($data->{forwarded})) {
688 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
690 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
692 if (length($data->{done})) {
693 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
696 &addmaintainers($data);
697 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
698 &addccaddress("$gForwardList\@$gListDomain");
700 $data->{forwarded}= $whereto;
701 } while (&getnextbug);
703 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
706 $bug_affected{$ref}=1;
708 if (!length($data->{forwarded})) {
709 &transcript("$gBug is not marked as having been forwarded.\n\n");
712 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
714 &addmaintainers($data);
715 $data->{forwarded}= '';
716 } while (&getnextbug);
719 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
720 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
723 $bug_affected{$ref}=1;
725 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
726 &transcript("Severity level \`$newseverity' is not known.\n".
727 "Recognized are: $gShowSeverities.\n\n");
729 } elsif (exists $gObsoleteSeverities{$newseverity}) {
730 &transcript("Severity level \`$newseverity' is obsolete. " .
731 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
734 $printseverity= $data->{severity};
735 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
736 $action= "Severity set to \`$newseverity' from \`$printseverity'";
738 &addmaintainers($data);
739 if (defined $gStrongList and isstrongseverity($newseverity)) {
740 addbcc("$gStrongList\@$gListDomain");
742 $data->{severity}= $newseverity;
743 } while (&getnextbug);
745 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
747 $ref = $1; $addsubcode = $3; $tags = $4;
748 $bug_affected{$ref}=1;
750 if (defined $addsubcode) {
751 $addsub = "sub" if ($addsubcode eq "-");
752 $addsub = "add" if ($addsubcode eq "+");
753 $addsub = "set" if ($addsubcode eq "=");
757 foreach my $t (split /[\s,]+/, $tags) {
758 if (!grep($_ eq $t, @gTags)) {
765 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
766 "Recognized are: ".join(' ', @gTags).".\n\n");
770 if ($data->{keywords} eq '') {
771 &transcript("There were no tags set.\n");
773 &transcript("Tags were: $data->{keywords}\n");
775 if ($addsub eq "set") {
776 $action= "Tags set to: " . join(", ", @okaytags);
777 } elsif ($addsub eq "add") {
778 $action= "Tags added: " . join(", ", @okaytags);
779 } elsif ($addsub eq "sub") {
780 $action= "Tags removed: " . join(", ", @okaytags);
783 &addmaintainers($data);
784 $data->{keywords} = '' if ($addsub eq "set");
785 # Allow removing obsolete tags.
786 if ($addsub eq "sub") {
787 foreach my $t (@badtags) {
788 $data->{keywords} = join ' ', grep $_ ne $t,
789 split ' ', $data->{keywords};
792 # Now process all other additions and subtractions.
793 foreach my $t (@okaytags) {
794 $data->{keywords} = join ' ', grep $_ ne $t,
795 split ' ', $data->{keywords};
796 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
798 $data->{keywords} =~ s/\s*$//;
799 } while (&getnextbug);
801 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
803 my $bugnum = $2; my $blockers = $4;
805 $addsub = "sub" if ($1 eq "un");
806 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
807 $bugnum = $clonebugs{$bugnum};
812 foreach my $b (split /[\s,]+/, $blockers) {
816 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
817 $ref = $clonebugs{$ref};
821 push @okayblockers, $ref;
823 # add to the list all bugs that are merged with $b,
824 # because all of their data must be kept in sync
825 @thisbugmergelist= split(/ /,$data->{mergedwith});
828 foreach $ref (@thisbugmergelist) {
830 push @okayblockers, $ref;
837 push @badblockers, $ref;
841 push @badblockers, $b;
845 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
851 if ($data->{blockedby} eq '') {
852 &transcript("Was not blocked by any bugs.\n");
854 &transcript("Was blocked by: $data->{blockedby}\n");
856 if ($addsub eq "set") {
857 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
858 } elsif ($addsub eq "add") {
859 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
860 } elsif ($addsub eq "sub") {
861 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
866 &addmaintainers($data);
867 my @oldblockerlist = split ' ', $data->{blockedby};
868 $data->{blockedby} = '' if ($addsub eq "set");
869 foreach my $b (@okayblockers) {
870 $data->{blockedby} = manipset($data->{blockedby}, $b,
874 foreach my $b (@oldblockerlist) {
875 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
876 push @{$removedblocks{$b}}, $ref;
879 foreach my $b (split ' ', $data->{blockedby}) {
880 if (! grep { $_ eq $b } @oldblockerlist) {
881 push @{$addedblocks{$b}}, $ref;
884 } while (&getnextbug);
886 # Now that the blockedby data is updated, change blocks data
887 # to match the changes.
888 foreach $ref (keys %addedblocks) {
890 foreach my $b (@{$addedblocks{$ref}}) {
891 $data->{blocks} = manipset($data->{blocks}, $b, 1);
896 foreach $ref (keys %removedblocks) {
898 foreach my $b (@{$removedblocks{$ref}}) {
899 $data->{blocks} = manipset($data->{blocks}, $b, 0);
905 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
907 $ref= $1; $newtitle= $2;
908 $bug_affected{$ref}=1;
909 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
910 $ref = $clonebugs{$ref};
913 if (&checkpkglimit) {
915 &addmaintainers($data);
916 my $oldtitle = $data->{subject};
917 $data->{subject}= $newtitle;
918 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
920 &transcript("$action\n");
921 if (length($data->{done})) {
922 &transcript("(By the way, that $gBug is currently marked as done.)\n");
931 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
934 $bug_affected{$ref} = 1;
936 if (!length($data->{mergedwith})) {
937 &transcript("$gBug is not marked as being merged with any others.\n\n");
940 $mergelowstate eq 'locked' || die "$mergelowstate ?";
941 $action= "Disconnected #$ref from all other report(s).";
942 @newmergelist= split(/ /,$data->{mergedwith});
944 @bug_affected{@newmergelist} = 1 x @newmergelist;
946 &addmaintainers($data);
947 $data->{mergedwith}= ($ref == $discref) ? ''
948 : join(' ',grep($_ ne $ref,@newmergelist));
949 } while (&getnextbug);
952 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
954 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
955 my @newmergelist= ();
960 while (defined($ref= shift(@tomerge))) {
961 &transcript("D| checking merge $ref\n") if $dl;
963 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
964 $ref = $clonebugs{$ref};
966 next if grep($_ == $ref,@newmergelist);
967 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
968 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
970 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
972 &checkmatch('package','m_package',$data->{package},@newmergelist);
973 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
974 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
975 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
976 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
977 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
978 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
979 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
980 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
981 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
982 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
983 if (length($mismatch)) {
984 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
987 &cancelbug; @newmergelist=(); last;
989 push(@newmergelist,$ref);
990 push(@tomerge,split(/ /,$data->{mergedwith}));
994 @newmergelist= sort { $a <=> $b } @newmergelist;
995 $action= "Merged @newmergelist.";
996 delete @fixed{keys %found};
997 for $ref (@newmergelist) {
998 &getbug || die "huh ? $gBug $ref disappeared during merge";
999 &addmaintainers($data);
1000 @bug_affected{@newmergelist} = 1 x @newmergelist;
1001 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1002 $data->{keywords}= join(' ', keys %tags);
1003 $data->{found_versions}= [sort keys %found];
1004 $data->{fixed_versions}= [sort keys %fixed];
1007 &transcript("$action\n\n");
1010 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1012 my @temp = split /\s+\#?/,$1;
1013 my $master_bug = shift @temp;
1014 my $master_bug_data;
1015 my @tomerge = sort { $a <=> $b } @temp;
1016 unshift @tomerge,$master_bug;
1017 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1018 my @newmergelist= ();
1022 # Here we try to do the right thing.
1023 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1024 # If not, we discard the found and fixed.
1025 # Everything else we set to the values of the first bug.
1027 while (defined($ref= shift(@tomerge))) {
1028 &transcript("D| checking merge $ref\n") if $dl;
1030 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1031 $ref = $clonebugs{$ref};
1033 next if grep($_ == $ref,@newmergelist);
1034 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1035 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1037 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1038 $master_bug_data = $data if not defined $master_bug_data;
1039 if ($data->{package} ne $master_bug_data->{package}) {
1040 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1041 "$gBug $ref is not in the same package as $master_bug\n");
1043 &cancelbug; @newmergelist=(); last;
1045 for my $t (split /\s+/,$data->{keywords}) {
1048 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1049 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1050 push(@newmergelist,$ref);
1051 push(@tomerge,split(/ /,$data->{mergedwith}));
1054 if (@newmergelist) {
1055 @newmergelist= sort { $a <=> $b } @newmergelist;
1056 $action= "Forcibly Merged @newmergelist.";
1057 delete @fixed{keys %found};
1058 for $ref (@newmergelist) {
1059 &getbug || die "huh ? $gBug $ref disappeared during merge";
1060 &addmaintainers($data);
1061 @bug_affected{@newmergelist} = 1 x @newmergelist;
1062 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1063 $data->{keywords}= join(' ', keys %tags);
1064 $data->{found_versions}= [sort keys %found];
1065 $data->{fixed_versions}= [sort keys %fixed];
1066 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1067 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1070 &transcript("$action\n\n");
1073 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1077 @newclonedids = split /\s+/, $2;
1078 $newbugsneeded = scalar(@newclonedids);
1081 $bug_affected{$ref} = 1;
1083 if (length($data->{mergedwith})) {
1084 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1088 &filelock("nextnumber.lock");
1089 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1090 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1091 $firstref= $v+0; $v += $newbugsneeded;
1092 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1095 $lastref = $firstref + $newbugsneeded - 1;
1097 if ($newbugsneeded == 1) {
1098 $action= "$gBug $origref cloned as bug $firstref.";
1100 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1103 my $blocks = $data->{blocks};
1104 my $blockedby = $data->{blockedby};
1107 my $ohash = get_hashname($origref);
1108 my $clone = $firstref;
1109 @bug_affected{@newclonedids} = 1 x @newclonedids;
1110 for $newclonedid (@newclonedids) {
1111 $clonebugs{$newclonedid} = $clone;
1113 my $hash = get_hashname($clone);
1114 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1115 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1116 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1117 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1118 &bughook('new', $clone, $data);
1120 # Update blocking info of bugs blocked by or blocking the
1122 foreach $ref (split ' ', $blocks) {
1124 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1127 foreach $ref (split ' ', $blockedby) {
1129 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1137 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1139 my @pkgs = split /\s+/, $1;
1140 if (scalar(@pkgs) > 0) {
1141 %limit_pkgs = map { ($_, 1) } @pkgs;
1142 &transcript("Ignoring bugs not assigned to: " .
1143 join(" ", keys(%limit_pkgs)) . "\n\n");
1146 &transcript("Not ignoring any bugs.\n\n");
1148 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1149 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1152 $bug_affected{$ref} = 1;
1154 if (length $data->{owner}) {
1155 $action = "Owner changed from $data->{owner} to $newowner.";
1157 $action = "Owner recorded as $newowner.";
1159 if (length $data->{done}) {
1160 $extramessage = "(By the way, this $gBug is currently " .
1161 "marked as done.)\n";
1164 &addmaintainers($data);
1165 $data->{owner} = $newowner;
1166 } while (&getnextbug);
1168 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1171 $bug_affected{$ref} = 1;
1173 if (length $data->{owner}) {
1174 $action = "Removed annotation that $gBug was owned by " .
1177 &addmaintainers($data);
1178 $data->{owner} = '';
1179 } while (&getnextbug);
1181 &transcript("$gBug is not marked as having an owner.\n\n");
1185 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1188 $bug_affected{$ref} = 1;
1191 bug_unarchive(bug => $ref,
1192 transcript => \$transcript,
1193 affected_bugs => \%bug_affected,
1194 requester => $header{from},
1195 request_addr => $controlrequestaddr,
1202 transcript($transcript."\n");
1203 } elsif (m/^archive\s+#?(\d+)$/i) {
1206 $bug_affected{$ref} = 1;
1208 if (exists $data->{unarchived}) {
1212 bug_archive(bug => $ref,
1213 transcript => \$transcript,
1215 affected_bugs => \%bug_affected,
1216 requester => $header{from},
1217 request_addr => $controlrequestaddr,
1224 transcript($transcript."\n");
1227 transcript("$gBug $ref has not been archived previously\n\n");
1233 &transcript("Unknown command or malformed arguments to command.\n\n");
1235 if (++$unknowns >= 5) {
1236 &transcript("Too many unknown commands, stopping here.\n\n");
1241 if ($procline>$#bodylines) {
1242 &transcript(">\nEnd of message, stopping processing here.\n\n");
1244 if (!$ok && !quickabort) {
1246 &transcript("No commands successfully parsed; sending the help text(s).\n");
1251 &transcript("MC\n") if $dl>1;
1253 for $maint (keys %maintccreasons) {
1254 &transcript("MM|$maint|\n") if $dl>1;
1255 next if $maint eq $replyto;
1257 $reasonsref= $maintccreasons{$maint};
1258 &transcript("MY|$maint|\n") if $dl>2;
1259 for $p (sort keys %$reasonsref) {
1260 &transcript("MP|$p|\n") if $dl>2;
1261 $reasonstring.= ', ' if length($reasonstring);
1262 $reasonstring.= $p.' ' if length($p);
1263 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1265 if (length($reasonstring) > 40) {
1266 (substr $reasonstring, 37) = "...";
1268 $reasonstring = "" if (!defined($reasonstring));
1269 push(@maintccs,"$maint ($reasonstring)");
1270 push(@maintccaddrs,"$maint");
1275 &transcript("MC|@maintccs|\n") if $dl>2;
1276 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1280 for my $maint (keys %maintccreasons) {
1281 for my $package (keys %{$maintccreasons{$maint}}) {
1282 next unless length $package;
1283 $packagepr{$package} = 1;
1287 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1289 # Add Bcc's to subscribed bugs
1290 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1292 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1293 $header{'subject'} = "your mail";
1296 # Error text here advertises how many errors there were
1297 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1300 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1302 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1303 In-Reply-To: $header{'message-id'}
1304 References: $header{'message-id'}
1305 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1307 ${packagepr}X-$gProject-PR-Message: transcript
1309 ${transcript}Please contact me if you need assistance.
1312 (administrator, $gProject $gBugs database)
1316 $repliedshow= join(', ',$replyto,@maintccaddrs);
1317 # -1 is the service.in log
1318 &filelock("lock/-1");
1319 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1321 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1323 "<strong>Request received</strong> from <code>".
1324 html_escape($header{'from'})."</code>\n".
1325 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1327 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1328 close(AP) || &quit("open db-h/-1.log: $!");
1330 utime(time,time,"db-h");
1332 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1334 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1336 sub sendmailmessage {
1337 local ($message,@recips) = @_;
1338 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1339 send_mail_message(message => $message,
1340 recipients => \@recips,
1346 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1347 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1351 #sub unimplemented {
1352 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1356 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1358 if (@newmergelist) {
1359 eval "\$mvarvalue= \$$mvarname";
1360 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1363 "Values for \`$string' don't match:\n".
1364 " #$newmergelist[0] has \`$mvarvalue';\n".
1365 " #$ref has \`$svarvalue'\n"
1366 if $mvarvalue ne $svarvalue;
1368 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1370 eval "\$$mvarname= \$svarvalue";
1375 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1376 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1388 my %h = map { $_ => 1 } split ' ', $list;
1395 return join ' ', sort keys %h;
1398 # High-level bug manipulation calls
1399 # Do announcements themselves
1401 # Possible calling sequences:
1402 # setbug (returns 0)
1404 # setbug (returns 1)
1405 # &transcript(something)
1408 # setbug (returns 1)
1409 # $action= (something)
1411 # (modify s_* variables)
1412 # } while (getnextbug);
1415 &dlen("nochangebug");
1416 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1418 &endmerge if $manybugs;
1420 &dlex("nochangebug");
1424 &dlen("setbug $ref");
1425 if ($ref =~ m/^-\d+/) {
1426 if (!defined $clonebugs{$ref}) {
1428 &dlex("setbug => noclone");
1431 $ref = $clonebugs{$ref};
1433 $state eq 'idle' || die "$state ?";
1436 &dlex("setbug => 0s");
1440 if (!&checkpkglimit) {
1445 @thisbugmergelist= split(/ /,$data->{mergedwith});
1446 if (!@thisbugmergelist) {
1451 &dlex("setbug => 1s");
1460 &dlex("setbug => 0mc");
1464 $state= 'multiple'; $sref=$ref;
1465 &dlex("setbug => 1m");
1470 &dlen("getnextbug");
1471 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1473 if (!$manybugs || !@thisbugmergelist) {
1474 length($action) || die;
1475 &transcript("$action\n$extramessage\n");
1476 &endmerge if $manybugs;
1478 &dlex("getnextbug => 0");
1481 $ref= shift(@thisbugmergelist);
1482 &getbug || die "bug $ref disappeared";
1484 &dlex("getnextbug => 1");
1488 # Low-level bug-manipulation calls
1489 # Do no announcements
1491 # getbug (returns 0)
1493 # getbug (returns 1)
1497 # $action= (something)
1498 # getbug (returns 1)
1500 # getbug (returns 1)
1502 # [getbug (returns 0)]
1503 # &transcript("$action\n\n")
1506 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1507 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1511 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1512 &filelock('lock/merge');
1513 $mergelowstate='locked';
1519 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1521 $mergelowstate='idle';
1526 &dlen("getbug $ref");
1527 $lowstate eq 'idle' || die "$state ?";
1528 if (($data = &lockreadbug($ref))) {
1531 &dlex("getbug => 1");
1536 &dlex("getbug => 0");
1542 $lowstate eq 'open' || die "$state ?";
1549 &dlen("savebug $ref");
1550 $lowstate eq 'open' || die "$lowstate ?";
1551 length($action) || die;
1552 $ref == $sref || die "read $sref but saving $ref ?";
1553 append_action_to_log(bug => $ref,
1555 requester => $header{from},
1556 request_addr => $controlrequestaddr,
1560 unlockwritebug($ref, $data);
1567 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1572 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1576 print $_[0] if $debug;
1577 $transcript.= $_[0];
1584 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1585 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1601 sub sendtxthelpraw {
1602 local ($relpath,$description) = @_;
1604 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1605 while(<D>) { $doc.=$_; }
1607 &transcript("Sending $description in separate message.\n");
1608 &sendmailmessage(<<END.$doc,$replyto);
1609 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1611 Subject: $gProject $gBug help: $description
1612 References: $header{'message-id'}
1613 In-Reply-To: $header{'message-id'}
1614 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1616 X-$gProject-PR-Message: doc-text $relpath
1622 sub sendlynxdocraw {
1623 local ($relpath,$description) = @_;
1625 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1626 while(<L>) { $doc.=$_; }
1628 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1629 &transcript("Information ($description) is not available -\n".
1630 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1633 &transcript("Error getting $description (code $? $!):\n$doc\n");
1635 &transcript("Sending $description.\n");
1636 &sendmailmessage(<<END.$doc,$replyto);
1637 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1639 Subject: $gProject $gBugs information: $description
1640 References: $header{'message-id'}
1641 In-Reply-To: $header{'message-id'}
1642 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1644 X-$gProject-PR-Message: doc-html $relpath
1653 $maintccreasons{$cca}{''}{$ref}= 1;
1656 sub addmaintainers {
1657 # Data structure is:
1658 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1661 &ensuremaintainersloaded;
1662 $anymaintfound=0; $anymaintnotfound=0;
1663 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1665 $p =~ /([a-z0-9.+-]+)/;
1667 next unless defined $p;
1668 if (defined $gSubscriptionDomain) {
1669 if (defined($pkgsrc{$p})) {
1670 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1672 addbcc("$p\@$gSubscriptionDomain");
1675 if (defined $data->{severity} and defined $gStrongList and
1676 isstrongseverity($data->{severity})) {
1677 addbcc("$gStrongList\@$gListDomain");
1679 if (defined($maintainerof{$p})) {
1680 $addmaint= $maintainerof{$p};
1681 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1682 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1683 print "maintainer add >$p|$addmaint<\n" if $debug;
1685 print "maintainer none >$p<\n" if $debug;
1686 &transcript("Warning: Unknown package '$p'\n");
1687 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1688 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1692 if (length $data->{owner}) {
1693 $addmaint = $data->{owner};
1694 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1695 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1696 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1700 sub ensuremaintainersloaded {
1702 return if $maintainersloaded++;
1703 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1707 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1708 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1709 $maintainerof{$a}= $2;
1712 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1716 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1717 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1718 $maintainerof{$a}= $2;
1721 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1723 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1724 my ($a, $b) = ($1, $2);
1725 $pkgsrc{lc($a)} = $b;
1731 local ($wherefrom,$path,$description) = @_;
1732 if ($wherefrom eq "ftp.d.o") {
1733 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1735 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1736 &transcript("$description is not available.\n");
1739 &transcript("Error getting $description (code $? $!):\n$doc\n");
1742 } elsif ($wherefrom eq "local") {
1744 $doc = do { local $/; <P> };
1747 &transcript("internal errror: info files location unknown.\n");
1750 &transcript("Sending $description.\n");
1751 &sendmailmessage(<<END.$doc,$replyto);
1752 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1754 Subject: $gProject $gBugs information: $description
1755 References: $header{'message-id'}
1756 In-Reply-To: $header{'message-id'}
1757 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1759 X-$gProject-PR-Message: getinfo
1761 $description follows: