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);
13 use Debbugs::Versions::Dpkg;
15 use Debbugs::Config qw(:globals :config);
16 use Debbugs::CGI qw(html_escape);
17 use Debbugs::Control qw(:archive :log);
18 use Debbugs::Log qw(:misc);
20 $lib_path = $gLibPath;
21 require "$lib_path/errorlib";
22 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
24 chdir("$gSpoolDir") || die "chdir spool: $!\n";
27 open DEBUG, ">/dev/null";
32 m/^[RC]\.\d+$/ || &quit("bad argument");
35 if (!rename("incoming/G$nn","incoming/P$nn")) {
36 $_=$!.''; m/no such file or directory/i && exit 0;
37 &quit("renaming to lock: $!");
40 open(M,"incoming/P$nn");
47 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
49 my $parser = new MIME::Parser;
50 mkdir "$gSpoolDir/mime.tmp", 0777;
51 $parser->output_under("$gSpoolDir/mime.tmp");
52 my $entity = eval { $parser->parse_data(join('',@log)) };
54 # header and decoded body respectively
55 my (@headerlines, @bodylines);
56 # Bug numbers to send e-mail to, hash so that we don't send to the
60 if ($entity and $entity->head->tags) {
61 @headerlines = @{$entity->head->header};
64 my $entity_body = getmailbody($entity);
65 @bodylines = $entity_body ? $entity_body->as_lines() : ();
68 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
70 for ($i = 0; $i <= $#msg; $i++) {
72 last unless length($_);
73 while ($msg[$i+1] =~ m/^\s/) {
77 push @headerlines, $_;
80 @bodylines = @msg[$i..$#msg];
84 $_ = decode_rfc1522($_);
86 print ">$_<\n" if $debug;
89 print ">$v=$_<\n" if $debug;
92 print "!>$_<\n" if $debug;
96 # Strip off RFC2440-style PGP clearsigning.
97 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
98 shift @bodylines while @bodylines and length $bodylines[0];
99 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
100 for my $findsig (0 .. $#bodylines) {
101 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
102 $#bodylines = $findsig - 1;
106 map { s/^- // } @bodylines;
109 grep(s/\s+$//,@bodylines);
111 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
113 if (defined $header{'resent-from'} && !defined $header{'from'}) {
114 $header{'from'} = $header{'resent-from'};
117 defined($header{'from'}) || &quit("no From header");
119 delete $header{'reply-to'}
120 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
122 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
123 $replyto = $header{'reply-to'};
125 $replyto = $header{'from'};
128 # This is an error counter which should be incremented every time there is an error.
130 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
132 &transcript("Processing commands for $controlrequestaddr:\n\n");
137 $mergelowstate= 'idle';
143 $user =~ s/^.*<(.*)>.*$/$1/;
144 $user =~ s/[(].*[)]//;
145 $user =~ s/^\s*(\S+)\s+.*$/$1/;
146 $user = "" unless (Debbugs::User::is_valid_user($user));
147 my $indicated_user = 0;
151 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
152 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
153 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
154 &transcript("Have a nice day\n\n.");
163 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
166 for ($procline=0; $procline<=$#bodylines; $procline++) {
167 $state eq 'idle' || print "$state ?\n";
168 $lowstate eq 'idle' || print "$lowstate ?\n";
169 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
171 &transcript("Stopping processing here.\n\n");
174 $_= $bodylines[$procline]; s/\s+$//;
176 &transcript("> $_\n");
179 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
180 &transcript("Stopping processing here.\n\n");
182 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
184 &transcript("Debug level $dl.\n\n");
185 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
187 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
188 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
190 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
191 "detailed logs for $gBug#$ref");
192 } elsif (m/^index(\s+full)?$/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-package$/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-summary(\s+by-number)?$/i) {
201 &transcript("This BTS function is currently disabled, sorry.\n\n");
203 $ok++; # well, it's not really ok, but it fixes #81224 :)
204 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
205 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
206 } elsif (m/^index(\s+|-)maints?$/i) {
207 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
208 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
210 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
211 "$gBug list for maintainer \`$maint'");
213 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
215 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
216 "$gBug list for package $package");
218 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/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+(last|-1)$/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/^send-unmatched\s+(old|-2)$/i) {
227 &transcript("This BTS function is currently disabled, sorry.\n\n");
229 $ok++; # well, it's not really ok, but it fixes #81224 :)
230 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
231 # the following is basically a Debian-specific kludge, but who cares
233 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
234 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
235 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
237 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
238 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
239 &sendinfo("local", "$gConfigDir/$req", "$req file");
241 &transcript("Info file $req does not exist.\n\n");
243 } elsif (m/^help/i) {
247 } elsif (m/^refcard/i) {
248 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
249 } elsif (m/^subscribe/i) {
251 There is no $gProject $gBug mailing list. If you wish to review bug reports
252 please do so via http://$gWebDomain/ or ask this mail server
254 soon: MAILINGLISTS_TEXT
256 } elsif (m/^unsubscribe/i) {
258 soon: UNSUBSCRIBE_TEXT
259 soon: MAILINGLISTS_TEXT
261 } elsif (m/^user\s+(\S+)\s*$/i) {
263 if (Debbugs::User::is_valid_user($newuser)) {
264 my $olduser = ($user ne "" ? " (was $user)" : "");
265 &transcript("Setting user to $newuser$olduser.\n");
269 &transcript("Selected user id ($newuser) invalid, sorry\n");
274 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
277 my $hidden = ($2 ne "");
284 &transcript("No valid user selected\n");
288 if (not $indicated_user and defined $user) {
289 &transcript("User is $user");
292 while (++$procline <= $#bodylines) {
293 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
297 &transcript("> $bodylines[$procline]\n");
299 my ($o, $txt) = ($1, $2);
300 if ($#cats == -1 && $o eq "+") {
301 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
307 unless (ref($cats[-1]) eq "HASH") {
308 $cats[-1] = { "nam" => $cats[-1],
309 "pri" => [], "ttl" => [] };
312 my ($desc, $ord, $op);
313 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
314 $desc = $1; $ord = $3; $op = "";
315 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
316 $desc = $1; $ord = $3; $op = $4;
317 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
318 $desc = ""; $op = $1;
320 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
325 $ord = 999 unless defined $ord;
328 push @{$cats[-1]->{"pri"}}, $prefix . $op;
329 push @{$cats[-1]->{"ttl"}}, $desc;
330 push @ords, "$ord $catsec";
332 @cats[-1]->{"def"} = $desc;
333 push @ords, "$ord DEF";
336 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
337 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
338 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
339 } elsif ($o eq "*") {
342 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
343 $name = $1; $prefix = $3;
345 $name = $txt; $prefix = "";
350 # XXX: got @cats, now do something with it
351 my $u = Debbugs::User::get_user($user);
353 &transcript("Added usercategory $catname.\n\n");
354 $u->{"categories"}->{$catname} = [ @cats ];
356 push @{$u->{visible_cats}},$catname;
359 &transcript("Removed usercategory $catname.\n\n");
360 delete $u->{"categories"}->{$catname};
361 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
364 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
366 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
367 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
368 $ref = $clonebugs{$ref};
371 &transcript("No valid user selected\n");
375 if (not $indicated_user and defined $user) {
376 &transcript("User is $user");
381 Debbugs::User::read_usertags(\%ut, $user);
382 my @oldtags = (); my @newtags = (); my @badtags = ();
384 for my $t (split /[,\s]+/, $tags) {
385 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
392 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
395 for my $t (keys %chtags) {
396 $ut{$t} = [] unless defined $ut{$t};
398 for my $t (keys %ut) {
399 my %res = map { ($_, 1) } @{$ut{$t}};
400 push @oldtags, $t if defined $res{$ref};
401 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
402 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
403 : $addsubcode eq "=");
404 $res{$ref} = 1 if ($addop && defined $chtags{$t});
405 delete $res{$ref} if ($del);
406 push @newtags, $t if defined $res{$ref};
407 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
410 &transcript("There were no usertags set.\n");
412 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
414 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
415 Debbugs::User::write_usertags(\%ut, $user);
417 } elsif (!$control) {
419 Unknown command or malformed arguments to command.
420 (Use control\@$gEmailDomain to manipulate reports.)
424 if (++$unknowns >= 3) {
425 &transcript("Too many unknown commands, stopping here.\n\n");
428 #### "developer only" ones start here
429 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
432 $bug_affected{$ref}=1;
435 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
436 if (length($data->{done}) and not defined($version)) {
437 &transcript("$gBug is already closed, cannot re-close.\n\n");
442 "marked as fixed in version $version" :
444 ", send any further explanations to $data->{originator}";
446 &addmaintainers($data);
447 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
448 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
449 $data->{done}= $replyto;
450 my @keywords= split ' ', $data->{keywords};
451 if (grep $_ eq 'pending', @keywords) {
452 $extramessage= "Removed pending tag.\n";
453 $data->{keywords}= join ' ', grep $_ ne 'pending',
456 addfixedversions($data, $data->{package}, $version, 'binary');
459 From: $gMaintainerEmail ($gProject $gBug Tracking System)
460 To: $data->{originator}
461 Subject: $gBug#$ref acknowledged by developer
463 References: $header{'message-id'} $data->{msgid}
464 In-Reply-To: $data->{msgid}
465 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
466 Reply-To: $ref\@$gEmailDomain
467 X-$gProject-PR-Message: they-closed-control $ref
469 This is an automatic notification regarding your $gBug report
470 #$ref: $data->{subject},
471 which was filed against the $data->{package} package.
473 It has been marked as closed by one of the developers, namely
476 You should be hearing from them with a substantive response shortly,
477 in case you haven't already. If not, please contact them directly.
480 (administrator, $gProject $gBugs database)
483 &sendmailmessage($message,$data->{originator});
484 } while (&getnextbug);
487 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
489 $ref= $1; $newpackage= $2;
490 $bug_affected{$ref}=1;
492 $newpackage =~ y/A-Z/a-z/;
494 if (length($data->{package})) {
495 $action= "$gBug reassigned from package \`$data->{package}'".
496 " to \`$newpackage'.";
498 $action= "$gBug assigned to package \`$newpackage'.";
501 &addmaintainers($data);
502 $data->{package}= $newpackage;
503 $data->{found_versions}= [];
504 $data->{fixed_versions}= [];
505 # TODO: what if $newpackage is a source package?
506 addfoundversions($data, $data->{package}, $version, 'binary');
507 &addmaintainers($data);
508 } while (&getnextbug);
510 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
511 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
512 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
513 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
516 $bug_affected{$ref}=1;
518 if (@{$data->{fixed_versions}}) {
519 &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");
521 if (!length($data->{done})) {
522 &transcript("$gBug is already open, cannot reopen.\n\n");
526 $noriginator eq '' ? "$gBug reopened, originator not changed." :
527 "$gBug reopened, originator set to $noriginator.";
529 &addmaintainers($data);
530 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
531 $data->{fixed_versions}= [];
533 } while (&getnextbug);
536 } elsif (m{^found\s+\#?(-?\d+)
537 (?:\s+(?:$config{package_name_re}\/)?
538 ($config{package_version_re}))?$}ix) {
543 if (!length($data->{done}) and not defined($version)) {
544 &transcript("$gBug is already open, cannot reopen.\n\n");
550 "$gBug marked as found in version $version." :
553 &addmaintainers($data);
554 # The 'done' field gets a bit weird with version
555 # tracking, because a bug may be closed by multiple
556 # people in different branches. Until we have something
557 # more flexible, we set it every time a bug is fixed,
558 # and clear it when a bug is found in a version greater
559 # than any version in which the bug is fixed or when
560 # a bug is found and there is no fixed version
561 if (defined $version) {
562 addfoundversions($data, $data->{package}, $version, 'binary');
563 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
564 @{$data->{fixed_versions}};
565 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version,$fixed_order[-1]) >= 0)) {
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 # Only use unmerged bugs here
1529 if (($data = &lockreadbug($ref,'db-h'))) {
1532 &dlex("getbug => 1");
1537 &dlex("getbug => 0");
1543 $lowstate eq 'open' || die "$state ?";
1550 &dlen("savebug $ref");
1551 $lowstate eq 'open' || die "$lowstate ?";
1552 length($action) || die;
1553 $ref == $sref || die "read $sref but saving $ref ?";
1554 append_action_to_log(bug => $ref,
1556 requester => $header{from},
1557 request_addr => $controlrequestaddr,
1561 unlockwritebug($ref, $data);
1568 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1573 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1577 print $_[0] if $debug;
1578 $transcript.= $_[0];
1585 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1586 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1602 sub sendtxthelpraw {
1603 local ($relpath,$description) = @_;
1605 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1606 while(<D>) { $doc.=$_; }
1608 &transcript("Sending $description in separate message.\n");
1609 &sendmailmessage(<<END.$doc,$replyto);
1610 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1612 Subject: $gProject $gBug help: $description
1613 References: $header{'message-id'}
1614 In-Reply-To: $header{'message-id'}
1615 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1617 X-$gProject-PR-Message: doc-text $relpath
1623 sub sendlynxdocraw {
1624 local ($relpath,$description) = @_;
1626 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1627 while(<L>) { $doc.=$_; }
1629 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1630 &transcript("Information ($description) is not available -\n".
1631 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1634 &transcript("Error getting $description (code $? $!):\n$doc\n");
1636 &transcript("Sending $description.\n");
1637 &sendmailmessage(<<END.$doc,$replyto);
1638 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1640 Subject: $gProject $gBugs information: $description
1641 References: $header{'message-id'}
1642 In-Reply-To: $header{'message-id'}
1643 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1645 X-$gProject-PR-Message: doc-html $relpath
1654 $maintccreasons{$cca}{''}{$ref}= 1;
1657 sub addmaintainers {
1658 # Data structure is:
1659 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1662 &ensuremaintainersloaded;
1663 $anymaintfound=0; $anymaintnotfound=0;
1664 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1666 $p =~ /([a-z0-9.+-]+)/;
1668 next unless defined $p;
1669 if (defined $gSubscriptionDomain) {
1670 if (defined($pkgsrc{$p})) {
1671 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1673 addbcc("$p\@$gSubscriptionDomain");
1676 if (defined $data->{severity} and defined $gStrongList and
1677 isstrongseverity($data->{severity})) {
1678 addbcc("$gStrongList\@$gListDomain");
1680 if (defined($maintainerof{$p})) {
1681 $addmaint= $maintainerof{$p};
1682 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1683 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1684 print "maintainer add >$p|$addmaint<\n" if $debug;
1686 print "maintainer none >$p<\n" if $debug;
1687 &transcript("Warning: Unknown package '$p'\n");
1688 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1689 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1693 if (length $data->{owner}) {
1694 $addmaint = $data->{owner};
1695 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1696 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1697 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1701 sub ensuremaintainersloaded {
1703 return if $maintainersloaded++;
1704 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1708 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1709 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1710 $maintainerof{$a}= $2;
1713 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1717 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1718 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1719 $maintainerof{$a}= $2;
1722 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1724 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1725 my ($a, $b) = ($1, $2);
1726 $pkgsrc{lc($a)} = $b;
1732 local ($wherefrom,$path,$description) = @_;
1733 if ($wherefrom eq "ftp.d.o") {
1734 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1736 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1737 &transcript("$description is not available.\n");
1740 &transcript("Error getting $description (code $? $!):\n$doc\n");
1743 } elsif ($wherefrom eq "local") {
1745 $doc = do { local $/; <P> };
1748 &transcript("internal errror: info files location unknown.\n");
1751 &transcript("Sending $description.\n");
1752 &sendmailmessage(<<END.$doc,$replyto);
1753 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1755 Subject: $gProject $gBugs information: $description
1756 References: $header{'message-id'}
1757 In-Reply-To: $header{'message-id'}
1758 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1760 X-$gProject-PR-Message: getinfo
1762 $description follows: