2 # $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
9 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
10 use Debbugs::Mail qw(send_mail_message);
12 use HTML::Entities qw(encode_entities);
14 use Debbugs::Config qw(:globals :config);
15 use Debbugs::CGI qw(html_escape);
16 $lib_path = $gLibPath;
17 require "$lib_path/errorlib";
18 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
20 chdir("$gSpoolDir") || die "chdir spool: $!\n";
23 open DEBUG, ">/dev/null";
28 m/^[RC]\.\d+$/ || &quit("bad argument");
31 if (!rename("incoming/G$nn","incoming/P$nn")) {
32 $_=$!.''; m/no such file or directory/i && exit 0;
33 &quit("renaming to lock: $!");
36 open(M,"incoming/P$nn");
43 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
45 my $parser = new MIME::Parser;
46 mkdir "$gSpoolDir/mime.tmp", 0777;
47 $parser->output_under("$gSpoolDir/mime.tmp");
48 my $entity = eval { $parser->parse_data(join('',@log)) };
50 # header and decoded body respectively
51 my (@headerlines, @bodylines);
52 # Bug numbers to send e-mail to, hash so that we don't send to the
56 if ($entity and $entity->head->tags) {
57 @headerlines = @{$entity->head->header};
60 my $entity_body = getmailbody($entity);
61 @bodylines = $entity_body ? $entity_body->as_lines() : ();
64 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
66 for ($i = 0; $i <= $#msg; $i++) {
68 last unless length($_);
69 while ($msg[$i+1] =~ m/^\s/) {
73 push @headerlines, $_;
76 @bodylines = @msg[$i..$#msg];
80 $_ = decode_rfc1522($_);
82 print ">$_<\n" if $debug;
85 print ">$v=$_<\n" if $debug;
88 print "!>$_<\n" if $debug;
92 # Strip off RFC2440-style PGP clearsigning.
93 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
94 shift @bodylines while @bodylines and length $bodylines[0];
95 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
96 for my $findsig (0 .. $#bodylines) {
97 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
98 $#bodylines = $findsig - 1;
102 map { s/^- // } @bodylines;
105 grep(s/\s+$//,@bodylines);
107 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
109 if (defined $header{'resent-from'} && !defined $header{'from'}) {
110 $header{'from'} = $header{'resent-from'};
113 defined($header{'from'}) || &quit("no From header");
115 delete $header{'reply-to'}
116 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
118 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
119 $replyto = $header{'reply-to'};
121 $replyto = $header{'from'};
124 # This is an error counter which should be incremented every time there is an error.
126 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
128 &transcript("Processing commands for $controlrequestaddr:\n\n");
133 $mergelowstate= 'idle';
139 $user =~ s/^.*<(.*)>.*$/$1/;
140 $user =~ s/[(].*[)]//;
141 $user =~ s/^\s*(\S+)\s+.*$/$1/;
142 $user = "" unless (Debbugs::User::is_valid_user($user));
143 my $indicated_user = 0;
147 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
148 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
149 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
150 &transcript("Have a nice day\n\n.");
159 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
162 for ($procline=0; $procline<=$#bodylines; $procline++) {
163 $state eq 'idle' || print "$state ?\n";
164 $lowstate eq 'idle' || print "$lowstate ?\n";
165 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
167 &transcript("Stopping processing here.\n\n");
170 $_= $bodylines[$procline]; s/\s+$//;
172 &transcript("> $_\n");
175 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
176 &transcript("Stopping processing here.\n\n");
178 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
180 &transcript("Debug level $dl.\n\n");
181 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
183 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
184 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
186 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
187 "detailed logs for $gBug#$ref");
188 } elsif (m/^index(\s+full)?$/i) {
189 &transcript("This BTS function is currently disabled, sorry.\n\n");
191 $ok++; # well, it's not really ok, but it fixes #81224 :)
192 } elsif (m/^index-summary\s+by-package$/i) {
193 &transcript("This BTS function is currently disabled, sorry.\n\n");
195 $ok++; # well, it's not really ok, but it fixes #81224 :)
196 } elsif (m/^index-summary(\s+by-number)?$/i) {
197 &transcript("This BTS function is currently disabled, sorry.\n\n");
199 $ok++; # well, it's not really ok, but it fixes #81224 :)
200 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
201 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
202 } elsif (m/^index(\s+|-)maints?$/i) {
203 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
204 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
206 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
207 "$gBug list for maintainer \`$maint'");
209 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
211 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
212 "$gBug list for package $package");
214 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
215 &transcript("This BTS function is currently disabled, sorry.\n\n");
217 $ok++; # well, it's not really ok, but it fixes #81224 :)
218 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
219 &transcript("This BTS function is currently disabled, sorry.\n\n");
221 $ok++; # well, it's not really ok, but it fixes #81224 :)
222 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
223 &transcript("This BTS function is currently disabled, sorry.\n\n");
225 $ok++; # well, it's not really ok, but it fixes #81224 :)
226 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
227 # the following is basically a Debian-specific kludge, but who cares
229 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
230 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
231 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
233 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
234 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
235 &sendinfo("local", "$gConfigDir/$req", "$req file");
237 &transcript("Info file $req does not exist.\n\n");
239 } elsif (m/^help/i) {
243 } elsif (m/^refcard/i) {
244 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
245 } elsif (m/^subscribe/i) {
247 There is no $gProject $gBug mailing list. If you wish to review bug reports
248 please do so via http://$gWebDomain/ or ask this mail server
250 soon: MAILINGLISTS_TEXT
252 } elsif (m/^unsubscribe/i) {
254 soon: UNSUBSCRIBE_TEXT
255 soon: MAILINGLISTS_TEXT
257 } elsif (m/^user\s+(\S+)\s*$/i) {
259 if (Debbugs::User::is_valid_user($newuser)) {
260 my $olduser = ($user ne "" ? " (was $user)" : "");
261 &transcript("Setting user to $newuser$olduser.\n");
265 &transcript("Selected user id ($newuser) invalid, sorry\n");
270 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
273 my $hidden = ($2 ne "");
280 &transcript("No valid user selected\n");
284 if (not $indicated_user and defined $user) {
285 &transcript("User is $user");
288 while (++$procline <= $#bodylines) {
289 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
293 &transcript("> $bodylines[$procline]\n");
295 my ($o, $txt) = ($1, $2);
296 if ($#cats == -1 && $o eq "+") {
297 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
303 unless (ref($cats[-1]) eq "HASH") {
304 $cats[-1] = { "nam" => $cats[-1],
305 "pri" => [], "ttl" => [] };
308 my ($desc, $ord, $op);
309 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
310 $desc = $1; $ord = $3; $op = "";
311 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
312 $desc = $1; $ord = $3; $op = $4;
313 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
314 $desc = ""; $op = $1;
316 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
321 $ord = 999 unless defined $ord;
324 push @{$cats[-1]->{"pri"}}, $prefix . $op;
325 push @{$cats[-1]->{"ttl"}}, $desc;
326 push @ords, "$ord $catsec";
328 @cats[-1]->{"def"} = $desc;
329 push @ords, "$ord DEF";
332 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
333 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
334 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
335 } elsif ($o eq "*") {
338 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
339 $name = $1; $prefix = $3;
341 $name = $txt; $prefix = "";
346 # XXX: got @cats, now do something with it
347 my $u = Debbugs::User::get_user($user);
349 &transcript("Added usercategory $catname.\n\n");
350 $u->{"categories"}->{$catname} = [ @cats ];
352 push @{$u->{visible_cats}},$catname;
355 &transcript("Removed usercategory $catname.\n\n");
356 delete $u->{"categories"}->{$catname};
357 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
360 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
362 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
363 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
364 $ref = $clonebugs{$ref};
367 &transcript("No valid user selected\n");
371 if (not $indicated_user and defined $user) {
372 &transcript("User is $user");
377 Debbugs::User::read_usertags(\%ut, $user);
378 my @oldtags = (); my @newtags = (); my @badtags = ();
380 for my $t (split /[,\s]+/, $tags) {
381 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
388 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
391 for my $t (keys %chtags) {
392 $ut{$t} = [] unless defined $ut{$t};
394 for my $t (keys %ut) {
395 my %res = map { ($_, 1) } @{$ut{$t}};
396 push @oldtags, $t if defined $res{$ref};
397 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
398 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
399 : $addsubcode eq "=");
400 $res{$ref} = 1 if ($addop && defined $chtags{$t});
401 delete $res{$ref} if ($del);
402 push @newtags, $t if defined $res{$ref};
403 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
406 &transcript("There were no usertags set.\n");
408 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
410 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
411 Debbugs::User::write_usertags(\%ut, $user);
413 } elsif (!$control) {
415 Unknown command or malformed arguments to command.
416 (Use control\@$gEmailDomain to manipulate reports.)
420 if (++$unknowns >= 3) {
421 &transcript("Too many unknown commands, stopping here.\n\n");
424 #### "developer only" ones start here
425 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
428 $bug_affected{$ref}=1;
431 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
432 if (length($data->{done}) and not defined($version)) {
433 &transcript("$gBug is already closed, cannot re-close.\n\n");
438 "marked as fixed in version $version" :
440 ", send any further explanations to $data->{originator}";
442 &addmaintainers($data);
443 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
444 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
445 $data->{done}= $replyto;
446 my @keywords= split ' ', $data->{keywords};
447 if (grep $_ eq 'pending', @keywords) {
448 $extramessage= "Removed pending tag.\n";
449 $data->{keywords}= join ' ', grep $_ ne 'pending',
452 addfixedversions($data, $data->{package}, $version, 'binary');
455 From: $gMaintainerEmail ($gProject $gBug Tracking System)
456 To: $data->{originator}
457 Subject: $gBug#$ref acknowledged by developer
459 References: $header{'message-id'} $data->{msgid}
460 In-Reply-To: $data->{msgid}
461 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
462 Reply-To: $ref\@$gEmailDomain
463 X-$gProject-PR-Message: they-closed-control $ref
465 This is an automatic notification regarding your $gBug report
466 #$ref: $data->{subject},
467 which was filed against the $data->{package} package.
469 It has been marked as closed by one of the developers, namely
472 You should be hearing from them with a substantive response shortly,
473 in case you haven't already. If not, please contact them directly.
476 (administrator, $gProject $gBugs database)
479 &sendmailmessage($message,$data->{originator});
480 } while (&getnextbug);
483 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
485 $ref= $1; $newpackage= $2;
486 $bug_affected{$ref}=1;
488 $newpackage =~ y/A-Z/a-z/;
490 if (length($data->{package})) {
491 $action= "$gBug reassigned from package \`$data->{package}'".
492 " to \`$newpackage'.";
494 $action= "$gBug assigned to package \`$newpackage'.";
497 &addmaintainers($data);
498 $data->{package}= $newpackage;
499 $data->{found_versions}= [];
500 $data->{fixed_versions}= [];
501 # TODO: what if $newpackage is a source package?
502 addfoundversions($data, $data->{package}, $version, 'binary');
503 &addmaintainers($data);
504 } while (&getnextbug);
506 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
507 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
508 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
509 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
512 $bug_affected{$ref}=1;
514 if (@{$data->{fixed_versions}}) {
515 &transcript("'reopen' may be inappropriate when a bug has been closed with a version;\nyou may need to use 'found' to remove fixed versions.\n");
517 if (!length($data->{done})) {
518 &transcript("$gBug is already open, cannot reopen.\n\n");
522 $noriginator eq '' ? "$gBug reopened, originator not changed." :
523 "$gBug reopened, originator set to $noriginator.";
525 &addmaintainers($data);
526 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
527 $data->{fixed_versions}= [];
529 } while (&getnextbug);
532 } elsif (m{^found\s+\#?(-?\d+)
533 (?:\s+(?:$config{package_name_re}\/)?
534 ($config{package_version_re}))?$}ix) {
539 if (!length($data->{done}) and not defined($version)) {
540 &transcript("$gBug is already open, cannot reopen.\n\n");
546 "$gBug marked as found in version $version." :
549 &addmaintainers($data);
550 # The 'done' field gets a bit weird with version
551 # tracking, because a bug may be closed by multiple
552 # people in different branches. Until we have something
553 # more flexible, we set it every time a bug is fixed,
554 # and clear it precisely when a found command is
555 # received for the rightmost fixed-in version, which
556 # equates to the most recent fixing of the bug, or when
557 # a versionless found command is received.
558 if (defined $version) {
559 my $lastfixed = $data->{fixed_versions}[-1];
560 # TODO: what if $data->{package} is a source package?
561 addfoundversions($data, $data->{package}, $version, 'binary');
562 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
566 # Versionless found; assume old-style "not fixed at
568 $data->{fixed_versions} = [];
571 } while (&getnextbug);
574 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
579 $action= "$gBug marked as not found in version $version.";
580 if (length($data->{done})) {
581 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
584 &addmaintainers($data);
585 removefoundversions($data, $data->{package}, $version, 'binary');
586 } while (&getnextbug);
589 elsif (m[^fixed\s+\#?(-?\d+)\s+
590 ((?:$config{package_name_re}\/)?
591 $config{package_version_re})\s*$]ix) {
598 "$gBug marked as fixed in version $version." :
601 &addmaintainers($data);
602 addfixedversions($data, $data->{package}, $version, 'binary');
603 } while (&getnextbug);
606 elsif (m[^notfixed\s+\#?(-?\d+)\s+
607 ((?:$config{package_name_re}\/)?
608 $config{package_version_re})\s*$]ix) {
615 "$gBug marked as not fixed in version $version." :
618 &addmaintainers($data);
619 removefixedversions($data, $data->{package}, $version, 'binary');
620 } while (&getnextbug);
623 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
624 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
627 $bug_affected{$ref}=1;
628 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
629 $ref = $clonebugs{$ref};
632 if (&checkpkglimit) {
634 &addmaintainers($data);
635 $oldsubmitter= $data->{originator};
636 $data->{originator}= $newsubmitter;
637 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
639 &transcript("$action\n");
640 if (length($data->{done})) {
641 &transcript("(By the way, that $gBug is currently marked as done.)\n");
645 From: $gMaintainerEmail ($gProject $gBug Tracking System)
647 Subject: $gBug#$ref submitter address changed
649 References: $header{'message-id'} $data->{msgid}
650 In-Reply-To: $data->{msgid}
651 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
652 Reply-To: $ref\@$gEmailDomain
653 X-$gProject-PR-Message: submitter-changed $ref
655 The submitter address recorded for your $gBug report
656 #$ref: $data->{subject}
659 The old submitter address for this report was
661 The new submitter address is
664 This change was made by
666 If it was incorrect, please contact them directly.
669 (administrator, $gProject $gBugs database)
672 &sendmailmessage($message,$oldsubmitter);
679 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
681 $ref= $1; $whereto= $2;
682 $bug_affected{$ref}=1;
684 if (length($data->{forwarded})) {
685 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
687 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
689 if (length($data->{done})) {
690 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
693 &addmaintainers($data);
694 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
695 &addccaddress("$gForwardList\@$gListDomain");
697 $data->{forwarded}= $whereto;
698 } while (&getnextbug);
700 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
703 $bug_affected{$ref}=1;
705 if (!length($data->{forwarded})) {
706 &transcript("$gBug is not marked as having been forwarded.\n\n");
709 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
711 &addmaintainers($data);
712 $data->{forwarded}= '';
713 } while (&getnextbug);
716 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
717 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
720 $bug_affected{$ref}=1;
722 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
723 &transcript("Severity level \`$newseverity' is not known.\n".
724 "Recognized are: $gShowSeverities.\n\n");
726 } elsif (exists $gObsoleteSeverities{$newseverity}) {
727 &transcript("Severity level \`$newseverity' is obsolete. " .
728 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
731 $printseverity= $data->{severity};
732 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
733 $action= "Severity set to \`$newseverity' from \`$printseverity'";
735 &addmaintainers($data);
736 if (defined $gStrongList and isstrongseverity($newseverity)) {
737 addbcc("$gStrongList\@$gListDomain");
739 $data->{severity}= $newseverity;
740 } while (&getnextbug);
742 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
744 $ref = $1; $addsubcode = $3; $tags = $4;
745 $bug_affected{$ref}=1;
747 if (defined $addsubcode) {
748 $addsub = "sub" if ($addsubcode eq "-");
749 $addsub = "add" if ($addsubcode eq "+");
750 $addsub = "set" if ($addsubcode eq "=");
754 foreach my $t (split /[\s,]+/, $tags) {
755 if (!grep($_ eq $t, @gTags)) {
762 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
763 "Recognized are: ".join(' ', @gTags).".\n\n");
767 if ($data->{keywords} eq '') {
768 &transcript("There were no tags set.\n");
770 &transcript("Tags were: $data->{keywords}\n");
772 if ($addsub eq "set") {
773 $action= "Tags set to: " . join(", ", @okaytags);
774 } elsif ($addsub eq "add") {
775 $action= "Tags added: " . join(", ", @okaytags);
776 } elsif ($addsub eq "sub") {
777 $action= "Tags removed: " . join(", ", @okaytags);
780 &addmaintainers($data);
781 $data->{keywords} = '' if ($addsub eq "set");
782 # Allow removing obsolete tags.
783 if ($addsub eq "sub") {
784 foreach my $t (@badtags) {
785 $data->{keywords} = join ' ', grep $_ ne $t,
786 split ' ', $data->{keywords};
789 # Now process all other additions and subtractions.
790 foreach my $t (@okaytags) {
791 $data->{keywords} = join ' ', grep $_ ne $t,
792 split ' ', $data->{keywords};
793 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
795 $data->{keywords} =~ s/\s*$//;
796 } while (&getnextbug);
798 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
800 my $bugnum = $2; my $blockers = $4;
802 $addsub = "sub" if ($1 eq "un");
803 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
804 $bugnum = $clonebugs{$bugnum};
809 foreach my $b (split /[\s,]+/, $blockers) {
813 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
814 $ref = $clonebugs{$ref};
818 push @okayblockers, $ref;
820 # add to the list all bugs that are merged with $b,
821 # because all of their data must be kept in sync
822 @thisbugmergelist= split(/ /,$data->{mergedwith});
825 foreach $ref (@thisbugmergelist) {
827 push @okayblockers, $ref;
834 push @badblockers, $ref;
838 push @badblockers, $b;
842 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
848 if ($data->{blockedby} eq '') {
849 &transcript("Was not blocked by any bugs.\n");
851 &transcript("Was blocked by: $data->{blockedby}\n");
853 if ($addsub eq "set") {
854 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
855 } elsif ($addsub eq "add") {
856 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
857 } elsif ($addsub eq "sub") {
858 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
863 &addmaintainers($data);
864 my @oldblockerlist = split ' ', $data->{blockedby};
865 $data->{blockedby} = '' if ($addsub eq "set");
866 foreach my $b (@okayblockers) {
867 $data->{blockedby} = manipset($data->{blockedby}, $b,
871 foreach my $b (@oldblockerlist) {
872 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
873 push @{$removedblocks{$b}}, $ref;
876 foreach my $b (split ' ', $data->{blockedby}) {
877 if (! grep { $_ eq $b } @oldblockerlist) {
878 push @{$addedblocks{$b}}, $ref;
881 } while (&getnextbug);
883 # Now that the blockedby data is updated, change blocks data
884 # to match the changes.
885 foreach $ref (keys %addedblocks) {
887 foreach my $b (@{$addedblocks{$ref}}) {
888 $data->{blocks} = manipset($data->{blocks}, $b, 1);
893 foreach $ref (keys %removedblocks) {
895 foreach my $b (@{$removedblocks{$ref}}) {
896 $data->{blocks} = manipset($data->{blocks}, $b, 0);
902 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
904 $ref= $1; $newtitle= $2;
905 $bug_affected{$ref}=1;
906 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
907 $ref = $clonebugs{$ref};
910 if (&checkpkglimit) {
912 &addmaintainers($data);
913 my $oldtitle = $data->{subject};
914 $data->{subject}= $newtitle;
915 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
917 &transcript("$action\n");
918 if (length($data->{done})) {
919 &transcript("(By the way, that $gBug is currently marked as done.)\n");
928 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
931 $bug_affected{$ref} = 1;
933 if (!length($data->{mergedwith})) {
934 &transcript("$gBug is not marked as being merged with any others.\n\n");
937 $mergelowstate eq 'locked' || die "$mergelowstate ?";
938 $action= "Disconnected #$ref from all other report(s).";
939 @newmergelist= split(/ /,$data->{mergedwith});
941 @bug_affected{@newmergelist} = 1 x @newmergelist;
943 &addmaintainers($data);
944 $data->{mergedwith}= ($ref == $discref) ? ''
945 : join(' ',grep($_ ne $ref,@newmergelist));
946 } while (&getnextbug);
949 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
951 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
952 my @newmergelist= ();
957 while (defined($ref= shift(@tomerge))) {
958 &transcript("D| checking merge $ref\n") if $dl;
960 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
961 $ref = $clonebugs{$ref};
963 next if grep($_ == $ref,@newmergelist);
964 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
965 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
967 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
969 &checkmatch('package','m_package',$data->{package},@newmergelist);
970 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
971 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
972 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
973 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
974 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
975 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
976 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
977 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
978 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
979 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
980 if (length($mismatch)) {
981 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
984 &cancelbug; @newmergelist=(); last;
986 push(@newmergelist,$ref);
987 push(@tomerge,split(/ /,$data->{mergedwith}));
991 @newmergelist= sort { $a <=> $b } @newmergelist;
992 $action= "Merged @newmergelist.";
993 delete @fixed{keys %found};
994 for $ref (@newmergelist) {
995 &getbug || die "huh ? $gBug $ref disappeared during merge";
996 &addmaintainers($data);
997 @bug_affected{@newmergelist} = 1 x @newmergelist;
998 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
999 $data->{keywords}= join(' ', keys %tags);
1000 $data->{found_versions}= [sort keys %found];
1001 $data->{fixed_versions}= [sort keys %fixed];
1004 &transcript("$action\n\n");
1007 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1009 my @temp = split /\s+\#?/,$1;
1010 my $master_bug = shift @temp;
1011 my $master_bug_data;
1012 my @tomerge = sort { $a <=> $b } @temp;
1013 unshift @tomerge,$master_bug;
1014 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1015 my @newmergelist= ();
1019 # Here we try to do the right thing.
1020 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1021 # If not, we discard the found and fixed.
1022 # Everything else we set to the values of the first bug.
1024 while (defined($ref= shift(@tomerge))) {
1025 &transcript("D| checking merge $ref\n") if $dl;
1027 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1028 $ref = $clonebugs{$ref};
1030 next if grep($_ == $ref,@newmergelist);
1031 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1032 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1034 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1035 $master_bug_data = $data if not defined $master_bug_data;
1036 if ($data->{package} ne $master_bug_data->{package}) {
1037 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1038 "$gBug $ref is not in the same package as $master_bug\n");
1040 &cancelbug; @newmergelist=(); last;
1042 for my $t (split /\s+/,$data->{keywords}) {
1045 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1046 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1047 push(@newmergelist,$ref);
1048 push(@tomerge,split(/ /,$data->{mergedwith}));
1051 if (@newmergelist) {
1052 @newmergelist= sort { $a <=> $b } @newmergelist;
1053 $action= "Forcibly Merged @newmergelist.";
1054 delete @fixed{keys %found};
1055 for $ref (@newmergelist) {
1056 &getbug || die "huh ? $gBug $ref disappeared during merge";
1057 &addmaintainers($data);
1058 @bug_affected{@newmergelist} = 1 x @newmergelist;
1059 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1060 $data->{keywords}= join(' ', keys %tags);
1061 $data->{found_versions}= [sort keys %found];
1062 $data->{fixed_versions}= [sort keys %fixed];
1063 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1064 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1067 &transcript("$action\n\n");
1070 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1074 @newclonedids = split /\s+/, $2;
1075 $newbugsneeded = scalar(@newclonedids);
1078 $bug_affected{$ref} = 1;
1080 if (length($data->{mergedwith})) {
1081 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1085 &filelock("nextnumber.lock");
1086 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1087 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1088 $firstref= $v+0; $v += $newbugsneeded;
1089 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1092 $lastref = $firstref + $newbugsneeded - 1;
1094 if ($newbugsneeded == 1) {
1095 $action= "$gBug $origref cloned as bug $firstref.";
1097 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1100 my $blocks = $data->{blocks};
1101 my $blockedby = $data->{blockedby};
1104 my $ohash = get_hashname($origref);
1105 my $clone = $firstref;
1106 @bug_affected{@newclonedids} = 1 x @newclonedids;
1107 for $newclonedid (@newclonedids) {
1108 $clonebugs{$newclonedid} = $clone;
1110 my $hash = get_hashname($clone);
1111 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1112 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1113 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1114 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1115 &bughook('new', $clone, $data);
1117 # Update blocking info of bugs blocked by or blocking the
1119 foreach $ref (split ' ', $blocks) {
1121 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1124 foreach $ref (split ' ', $blockedby) {
1126 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1134 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1136 my @pkgs = split /\s+/, $1;
1137 if (scalar(@pkgs) > 0) {
1138 %limit_pkgs = map { ($_, 1) } @pkgs;
1139 &transcript("Ignoring bugs not assigned to: " .
1140 join(" ", keys(%limit_pkgs)) . "\n\n");
1143 &transcript("Not ignoring any bugs.\n\n");
1145 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1146 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1149 $bug_affected{$ref} = 1;
1151 if (length $data->{owner}) {
1152 $action = "Owner changed from $data->{owner} to $newowner.";
1154 $action = "Owner recorded as $newowner.";
1156 if (length $data->{done}) {
1157 $extramessage = "(By the way, this $gBug is currently " .
1158 "marked as done.)\n";
1161 &addmaintainers($data);
1162 $data->{owner} = $newowner;
1163 } while (&getnextbug);
1165 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1168 $bug_affected{$ref} = 1;
1170 if (length $data->{owner}) {
1171 $action = "Removed annotation that $gBug was owned by " .
1174 &addmaintainers($data);
1175 $data->{owner} = '';
1176 } while (&getnextbug);
1178 &transcript("$gBug is not marked as having an owner.\n\n");
1183 &transcript("Unknown command or malformed arguments to command.\n\n");
1185 if (++$unknowns >= 5) {
1186 &transcript("Too many unknown commands, stopping here.\n\n");
1191 if ($procline>$#bodylines) {
1192 &transcript(">\nEnd of message, stopping processing here.\n\n");
1194 if (!$ok && !quickabort) {
1196 &transcript("No commands successfully parsed; sending the help text(s).\n");
1201 &transcript("MC\n") if $dl>1;
1203 for $maint (keys %maintccreasons) {
1204 &transcript("MM|$maint|\n") if $dl>1;
1205 next if $maint eq $replyto;
1207 $reasonsref= $maintccreasons{$maint};
1208 &transcript("MY|$maint|\n") if $dl>2;
1209 for $p (sort keys %$reasonsref) {
1210 &transcript("MP|$p|\n") if $dl>2;
1211 $reasonstring.= ', ' if length($reasonstring);
1212 $reasonstring.= $p.' ' if length($p);
1213 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1215 if (length($reasonstring) > 40) {
1216 (substr $reasonstring, 37) = "...";
1218 $reasonstring = "" if (!defined($reasonstring));
1219 push(@maintccs,"$maint ($reasonstring)");
1220 push(@maintccaddrs,"$maint");
1225 &transcript("MC|@maintccs|\n") if $dl>2;
1226 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1230 for my $maint (keys %maintccreasons) {
1231 for my $package (keys %{$maintccreasons{$maint}}) {
1232 next unless length $package;
1233 $packagepr{$package} = 1;
1237 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1239 # Add Bcc's to subscribed bugs
1240 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1242 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1243 $header{'subject'} = "your mail";
1246 # Error text here advertises how many errors there were
1247 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1250 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1252 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1253 In-Reply-To: $header{'message-id'}
1254 References: $header{'message-id'}
1255 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1257 ${packagepr}X-$gProject-PR-Message: transcript
1259 ${transcript}Please contact me if you need assistance.
1262 (administrator, $gProject $gBugs database)
1266 $repliedshow= join(', ',$replyto,@maintccaddrs);
1267 &filelock("lock/-1");
1268 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1270 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1272 "<strong>Request received</strong> from <code>".
1273 html_escape($header{'from'})."</code>\n".
1274 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1276 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1277 close(AP) || &quit("open db-h/-1.log: $!");
1279 utime(time,time,"db-h");
1281 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1283 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1285 sub sendmailmessage {
1286 local ($message,@recips) = @_;
1287 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1288 send_mail_message(message => $message,
1289 recipients => \@recips,
1295 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1296 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1300 #sub unimplemented {
1301 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1305 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1307 if (@newmergelist) {
1308 eval "\$mvarvalue= \$$mvarname";
1309 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1312 "Values for \`$string' don't match:\n".
1313 " #$newmergelist[0] has \`$mvarvalue';\n".
1314 " #$ref has \`$svarvalue'\n"
1315 if $mvarvalue ne $svarvalue;
1317 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1319 eval "\$$mvarname= \$svarvalue";
1324 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1325 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1337 my %h = map { $_ => 1 } split ' ', $list;
1344 return join ' ', sort keys %h;
1347 # High-level bug manipulation calls
1348 # Do announcements themselves
1350 # Possible calling sequences:
1351 # setbug (returns 0)
1353 # setbug (returns 1)
1354 # &transcript(something)
1357 # setbug (returns 1)
1358 # $action= (something)
1360 # (modify s_* variables)
1361 # } while (getnextbug);
1364 &dlen("nochangebug");
1365 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1367 &endmerge if $manybugs;
1369 &dlex("nochangebug");
1373 &dlen("setbug $ref");
1374 if ($ref =~ m/^-\d+/) {
1375 if (!defined $clonebugs{$ref}) {
1377 &dlex("setbug => noclone");
1380 $ref = $clonebugs{$ref};
1382 $state eq 'idle' || die "$state ?";
1385 &dlex("setbug => 0s");
1389 if (!&checkpkglimit) {
1394 @thisbugmergelist= split(/ /,$data->{mergedwith});
1395 if (!@thisbugmergelist) {
1400 &dlex("setbug => 1s");
1409 &dlex("setbug => 0mc");
1413 $state= 'multiple'; $sref=$ref;
1414 &dlex("setbug => 1m");
1419 &dlen("getnextbug");
1420 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1422 if (!$manybugs || !@thisbugmergelist) {
1423 length($action) || die;
1424 &transcript("$action\n$extramessage\n");
1425 &endmerge if $manybugs;
1427 &dlex("getnextbug => 0");
1430 $ref= shift(@thisbugmergelist);
1431 &getbug || die "bug $ref disappeared";
1433 &dlex("getnextbug => 1");
1437 # Low-level bug-manipulation calls
1438 # Do no announcements
1440 # getbug (returns 0)
1442 # getbug (returns 1)
1446 # $action= (something)
1447 # getbug (returns 1)
1449 # getbug (returns 1)
1451 # [getbug (returns 0)]
1452 # &transcript("$action\n\n")
1455 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1456 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1460 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1461 &filelock('lock/merge');
1462 $mergelowstate='locked';
1468 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1470 $mergelowstate='idle';
1475 &dlen("getbug $ref");
1476 $lowstate eq 'idle' || die "$state ?";
1477 if (($data = &lockreadbug($ref))) {
1480 &dlex("getbug => 1");
1485 &dlex("getbug => 0");
1491 $lowstate eq 'open' || die "$state ?";
1498 &dlen("savebug $ref");
1499 $lowstate eq 'open' || die "$lowstate ?";
1500 length($action) || die;
1501 $ref == $sref || die "read $sref but saving $ref ?";
1502 my $hash = get_hashname($ref);
1503 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1506 "<!-- time:".time." -->\n".
1507 "<strong>".html_escape($action)."</strong>\n".
1508 "Request was from <code>".html_escape($header{'from'})."</code>\n".
1509 "to <code>".html_escape($controlrequestaddr)."</code>. \n".
1511 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1512 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1513 unlockwritebug($ref, $data);
1520 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1525 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1529 print $_[0] if $debug;
1530 $transcript.= $_[0];
1537 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1538 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1554 sub sendtxthelpraw {
1555 local ($relpath,$description) = @_;
1557 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1558 while(<D>) { $doc.=$_; }
1560 &transcript("Sending $description in separate message.\n");
1561 &sendmailmessage(<<END.$doc,$replyto);
1562 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1564 Subject: $gProject $gBug help: $description
1565 References: $header{'message-id'}
1566 In-Reply-To: $header{'message-id'}
1567 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1569 X-$gProject-PR-Message: doc-text $relpath
1575 sub sendlynxdocraw {
1576 local ($relpath,$description) = @_;
1578 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1579 while(<L>) { $doc.=$_; }
1581 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1582 &transcript("Information ($description) is not available -\n".
1583 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1586 &transcript("Error getting $description (code $? $!):\n$doc\n");
1588 &transcript("Sending $description.\n");
1589 &sendmailmessage(<<END.$doc,$replyto);
1590 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1592 Subject: $gProject $gBugs information: $description
1593 References: $header{'message-id'}
1594 In-Reply-To: $header{'message-id'}
1595 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1597 X-$gProject-PR-Message: doc-html $relpath
1606 $maintccreasons{$cca}{''}{$ref}= 1;
1609 sub addmaintainers {
1610 # Data structure is:
1611 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1614 &ensuremaintainersloaded;
1615 $anymaintfound=0; $anymaintnotfound=0;
1616 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1618 $p =~ /([a-z0-9.+-]+)/;
1620 next unless defined $p;
1621 if (defined $gSubscriptionDomain) {
1622 if (defined($pkgsrc{$p})) {
1623 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1625 addbcc("$p\@$gSubscriptionDomain");
1628 if (defined $data->{severity} and defined $gStrongList and
1629 isstrongseverity($data->{severity})) {
1630 addbcc("$gStrongList\@$gListDomain");
1632 if (defined($maintainerof{$p})) {
1633 $addmaint= $maintainerof{$p};
1634 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1635 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1636 print "maintainer add >$p|$addmaint<\n" if $debug;
1638 print "maintainer none >$p<\n" if $debug;
1639 &transcript("Warning: Unknown package '$p'\n");
1640 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1641 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1645 if (length $data->{owner}) {
1646 $addmaint = $data->{owner};
1647 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1648 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1649 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1653 sub ensuremaintainersloaded {
1655 return if $maintainersloaded++;
1656 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1660 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1661 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1662 $maintainerof{$a}= $2;
1665 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1669 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1670 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1671 $maintainerof{$a}= $2;
1674 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1676 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1677 my ($a, $b) = ($1, $2);
1678 $pkgsrc{lc($a)} = $b;
1684 local ($wherefrom,$path,$description) = @_;
1685 if ($wherefrom eq "ftp.d.o") {
1686 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1688 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1689 &transcript("$description is not available.\n");
1692 &transcript("Error getting $description (code $? $!):\n$doc\n");
1695 } elsif ($wherefrom eq "local") {
1697 $doc = do { local $/; <P> };
1700 &transcript("internal errror: info files location unknown.\n");
1703 &transcript("Sending $description.\n");
1704 &sendmailmessage(<<END.$doc,$replyto);
1705 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1707 Subject: $gProject $gBugs information: $description
1708 References: $header{'message-id'}
1709 In-Reply-To: $header{'message-id'}
1710 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1712 X-$gProject-PR-Message: getinfo
1714 $description follows: