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 my ($version_only) = $version =~ m{([^/]+)$};
563 addfoundversions($data, $data->{package}, $version, 'binary');
564 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
565 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
566 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
568 $action = "$gBug marked as found in version $version and reopened.";
571 # Versionless found; assume old-style "not fixed at
573 $data->{fixed_versions} = [];
576 } while (&getnextbug);
579 } elsif (m[^notfound\s+\#?(-?\d+)
580 (?:\s+(?:$config{package_name_re}\/)?
581 ($config{package_version_re}))$]ix) {
586 $action= "$gBug marked as not found in version $version.";
587 if (length($data->{done})) {
588 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
591 &addmaintainers($data);
592 removefoundversions($data, $data->{package}, $version, 'binary');
593 } while (&getnextbug);
596 elsif (m[^fixed\s+\#?(-?\d+)\s+
597 ((?:$config{package_name_re}\/)?
598 $config{package_version_re})\s*$]ix) {
605 "$gBug marked as fixed in version $version." :
608 &addmaintainers($data);
609 addfixedversions($data, $data->{package}, $version, 'binary');
610 } while (&getnextbug);
613 elsif (m[^notfixed\s+\#?(-?\d+)\s+
614 ((?:$config{package_name_re}\/)?
615 $config{package_version_re})\s*$]ix) {
622 "$gBug marked as not fixed in version $version." :
625 &addmaintainers($data);
626 removefixedversions($data, $data->{package}, $version, 'binary');
627 } while (&getnextbug);
630 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
631 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
634 $bug_affected{$ref}=1;
635 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
636 $ref = $clonebugs{$ref};
639 if (&checkpkglimit) {
641 &addmaintainers($data);
642 $oldsubmitter= $data->{originator};
643 $data->{originator}= $newsubmitter;
644 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
646 &transcript("$action\n");
647 if (length($data->{done})) {
648 &transcript("(By the way, that $gBug is currently marked as done.)\n");
652 From: $gMaintainerEmail ($gProject $gBug Tracking System)
654 Subject: $gBug#$ref submitter address changed
656 References: $header{'message-id'} $data->{msgid}
657 In-Reply-To: $data->{msgid}
658 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
659 Reply-To: $ref\@$gEmailDomain
660 X-$gProject-PR-Message: submitter-changed $ref
662 The submitter address recorded for your $gBug report
663 #$ref: $data->{subject}
666 The old submitter address for this report was
668 The new submitter address is
671 This change was made by
673 If it was incorrect, please contact them directly.
676 (administrator, $gProject $gBugs database)
679 &sendmailmessage($message,$oldsubmitter);
686 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
688 $ref= $1; $whereto= $2;
689 $bug_affected{$ref}=1;
691 if (length($data->{forwarded})) {
692 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
694 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
696 if (length($data->{done})) {
697 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
700 &addmaintainers($data);
701 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
702 &addccaddress("$gForwardList\@$gListDomain");
704 $data->{forwarded}= $whereto;
705 } while (&getnextbug);
707 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
710 $bug_affected{$ref}=1;
712 if (!length($data->{forwarded})) {
713 &transcript("$gBug is not marked as having been forwarded.\n\n");
716 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
718 &addmaintainers($data);
719 $data->{forwarded}= '';
720 } while (&getnextbug);
723 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
724 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
727 $bug_affected{$ref}=1;
729 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
730 &transcript("Severity level \`$newseverity' is not known.\n".
731 "Recognized are: $gShowSeverities.\n\n");
733 } elsif (exists $gObsoleteSeverities{$newseverity}) {
734 &transcript("Severity level \`$newseverity' is obsolete. " .
735 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
738 $printseverity= $data->{severity};
739 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
740 $action= "Severity set to \`$newseverity' from \`$printseverity'";
742 &addmaintainers($data);
743 if (defined $gStrongList and isstrongseverity($newseverity)) {
744 addbcc("$gStrongList\@$gListDomain");
746 $data->{severity}= $newseverity;
747 } while (&getnextbug);
749 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
751 $ref = $1; $addsubcode = $3; $tags = $4;
752 $bug_affected{$ref}=1;
754 if (defined $addsubcode) {
755 $addsub = "sub" if ($addsubcode eq "-");
756 $addsub = "add" if ($addsubcode eq "+");
757 $addsub = "set" if ($addsubcode eq "=");
761 foreach my $t (split /[\s,]+/, $tags) {
762 if (!grep($_ eq $t, @gTags)) {
769 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
770 "Recognized are: ".join(' ', @gTags).".\n\n");
774 if ($data->{keywords} eq '') {
775 &transcript("There were no tags set.\n");
777 &transcript("Tags were: $data->{keywords}\n");
779 if ($addsub eq "set") {
780 $action= "Tags set to: " . join(", ", @okaytags);
781 } elsif ($addsub eq "add") {
782 $action= "Tags added: " . join(", ", @okaytags);
783 } elsif ($addsub eq "sub") {
784 $action= "Tags removed: " . join(", ", @okaytags);
787 &addmaintainers($data);
788 $data->{keywords} = '' if ($addsub eq "set");
789 # Allow removing obsolete tags.
790 if ($addsub eq "sub") {
791 foreach my $t (@badtags) {
792 $data->{keywords} = join ' ', grep $_ ne $t,
793 split ' ', $data->{keywords};
796 # Now process all other additions and subtractions.
797 foreach my $t (@okaytags) {
798 $data->{keywords} = join ' ', grep $_ ne $t,
799 split ' ', $data->{keywords};
800 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
802 $data->{keywords} =~ s/\s*$//;
803 } while (&getnextbug);
805 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
807 my $bugnum = $2; my $blockers = $4;
809 $addsub = "sub" if ($1 eq "un");
810 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
811 $bugnum = $clonebugs{$bugnum};
816 foreach my $b (split /[\s,]+/, $blockers) {
820 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
821 $ref = $clonebugs{$ref};
825 push @okayblockers, $ref;
827 # add to the list all bugs that are merged with $b,
828 # because all of their data must be kept in sync
829 @thisbugmergelist= split(/ /,$data->{mergedwith});
832 foreach $ref (@thisbugmergelist) {
834 push @okayblockers, $ref;
841 push @badblockers, $ref;
845 push @badblockers, $b;
849 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
855 if ($data->{blockedby} eq '') {
856 &transcript("Was not blocked by any bugs.\n");
858 &transcript("Was blocked by: $data->{blockedby}\n");
860 if ($addsub eq "set") {
861 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
862 } elsif ($addsub eq "add") {
863 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
864 } elsif ($addsub eq "sub") {
865 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
870 &addmaintainers($data);
871 my @oldblockerlist = split ' ', $data->{blockedby};
872 $data->{blockedby} = '' if ($addsub eq "set");
873 foreach my $b (@okayblockers) {
874 $data->{blockedby} = manipset($data->{blockedby}, $b,
878 foreach my $b (@oldblockerlist) {
879 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
880 push @{$removedblocks{$b}}, $ref;
883 foreach my $b (split ' ', $data->{blockedby}) {
884 if (! grep { $_ eq $b } @oldblockerlist) {
885 push @{$addedblocks{$b}}, $ref;
888 } while (&getnextbug);
890 # Now that the blockedby data is updated, change blocks data
891 # to match the changes.
892 foreach $ref (keys %addedblocks) {
894 foreach my $b (@{$addedblocks{$ref}}) {
895 $data->{blocks} = manipset($data->{blocks}, $b, 1);
900 foreach $ref (keys %removedblocks) {
902 foreach my $b (@{$removedblocks{$ref}}) {
903 $data->{blocks} = manipset($data->{blocks}, $b, 0);
909 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
911 $ref= $1; $newtitle= $2;
912 $bug_affected{$ref}=1;
913 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
914 $ref = $clonebugs{$ref};
917 if (&checkpkglimit) {
919 &addmaintainers($data);
920 my $oldtitle = $data->{subject};
921 $data->{subject}= $newtitle;
922 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
924 &transcript("$action\n");
925 if (length($data->{done})) {
926 &transcript("(By the way, that $gBug is currently marked as done.)\n");
935 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
938 $bug_affected{$ref} = 1;
940 if (!length($data->{mergedwith})) {
941 &transcript("$gBug is not marked as being merged with any others.\n\n");
944 $mergelowstate eq 'locked' || die "$mergelowstate ?";
945 $action= "Disconnected #$ref from all other report(s).";
946 @newmergelist= split(/ /,$data->{mergedwith});
948 @bug_affected{@newmergelist} = 1 x @newmergelist;
950 &addmaintainers($data);
951 $data->{mergedwith}= ($ref == $discref) ? ''
952 : join(' ',grep($_ ne $ref,@newmergelist));
953 } while (&getnextbug);
956 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
958 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
959 my @newmergelist= ();
964 while (defined($ref= shift(@tomerge))) {
965 &transcript("D| checking merge $ref\n") if $dl;
967 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
968 $ref = $clonebugs{$ref};
970 next if grep($_ == $ref,@newmergelist);
971 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
972 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
974 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
976 &checkmatch('package','m_package',$data->{package},@newmergelist);
977 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
978 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
979 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
980 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
981 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
982 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
983 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
984 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
985 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
986 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
987 if (length($mismatch)) {
988 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
991 &cancelbug; @newmergelist=(); last;
993 push(@newmergelist,$ref);
994 push(@tomerge,split(/ /,$data->{mergedwith}));
998 @newmergelist= sort { $a <=> $b } @newmergelist;
999 $action= "Merged @newmergelist.";
1000 delete @fixed{keys %found};
1001 for $ref (@newmergelist) {
1002 &getbug || die "huh ? $gBug $ref disappeared during merge";
1003 &addmaintainers($data);
1004 @bug_affected{@newmergelist} = 1 x @newmergelist;
1005 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1006 $data->{keywords}= join(' ', keys %tags);
1007 $data->{found_versions}= [sort keys %found];
1008 $data->{fixed_versions}= [sort keys %fixed];
1011 &transcript("$action\n\n");
1014 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1016 my @temp = split /\s+\#?/,$1;
1017 my $master_bug = shift @temp;
1018 my $master_bug_data;
1019 my @tomerge = sort { $a <=> $b } @temp;
1020 unshift @tomerge,$master_bug;
1021 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1022 my @newmergelist= ();
1026 # Here we try to do the right thing.
1027 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1028 # If not, we discard the found and fixed.
1029 # Everything else we set to the values of the first bug.
1031 while (defined($ref= shift(@tomerge))) {
1032 &transcript("D| checking merge $ref\n") if $dl;
1034 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1035 $ref = $clonebugs{$ref};
1037 next if grep($_ == $ref,@newmergelist);
1038 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1039 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1041 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1042 $master_bug_data = $data if not defined $master_bug_data;
1043 if ($data->{package} ne $master_bug_data->{package}) {
1044 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1045 "$gBug $ref is not in the same package as $master_bug\n");
1047 &cancelbug; @newmergelist=(); last;
1049 for my $t (split /\s+/,$data->{keywords}) {
1052 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1053 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1054 push(@newmergelist,$ref);
1055 push(@tomerge,split(/ /,$data->{mergedwith}));
1058 if (@newmergelist) {
1059 @newmergelist= sort { $a <=> $b } @newmergelist;
1060 $action= "Forcibly Merged @newmergelist.";
1061 delete @fixed{keys %found};
1062 for $ref (@newmergelist) {
1063 &getbug || die "huh ? $gBug $ref disappeared during merge";
1064 &addmaintainers($data);
1065 @bug_affected{@newmergelist} = 1 x @newmergelist;
1066 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1067 $data->{keywords}= join(' ', keys %tags);
1068 $data->{found_versions}= [sort keys %found];
1069 $data->{fixed_versions}= [sort keys %fixed];
1070 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1071 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1074 &transcript("$action\n\n");
1077 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1081 @newclonedids = split /\s+/, $2;
1082 $newbugsneeded = scalar(@newclonedids);
1085 $bug_affected{$ref} = 1;
1087 if (length($data->{mergedwith})) {
1088 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1092 &filelock("nextnumber.lock");
1093 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1094 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1095 $firstref= $v+0; $v += $newbugsneeded;
1096 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1099 $lastref = $firstref + $newbugsneeded - 1;
1101 if ($newbugsneeded == 1) {
1102 $action= "$gBug $origref cloned as bug $firstref.";
1104 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1107 my $blocks = $data->{blocks};
1108 my $blockedby = $data->{blockedby};
1111 my $ohash = get_hashname($origref);
1112 my $clone = $firstref;
1113 @bug_affected{@newclonedids} = 1 x @newclonedids;
1114 for $newclonedid (@newclonedids) {
1115 $clonebugs{$newclonedid} = $clone;
1117 my $hash = get_hashname($clone);
1118 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1119 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1120 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1121 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1122 &bughook('new', $clone, $data);
1124 # Update blocking info of bugs blocked by or blocking the
1126 foreach $ref (split ' ', $blocks) {
1128 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1131 foreach $ref (split ' ', $blockedby) {
1133 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1141 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1143 my @pkgs = split /\s+/, $1;
1144 if (scalar(@pkgs) > 0) {
1145 %limit_pkgs = map { ($_, 1) } @pkgs;
1146 &transcript("Ignoring bugs not assigned to: " .
1147 join(" ", keys(%limit_pkgs)) . "\n\n");
1150 &transcript("Not ignoring any bugs.\n\n");
1152 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1153 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1156 $bug_affected{$ref} = 1;
1158 if (length $data->{owner}) {
1159 $action = "Owner changed from $data->{owner} to $newowner.";
1161 $action = "Owner recorded as $newowner.";
1163 if (length $data->{done}) {
1164 $extramessage = "(By the way, this $gBug is currently " .
1165 "marked as done.)\n";
1168 &addmaintainers($data);
1169 $data->{owner} = $newowner;
1170 } while (&getnextbug);
1172 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1175 $bug_affected{$ref} = 1;
1177 if (length $data->{owner}) {
1178 $action = "Removed annotation that $gBug was owned by " .
1181 &addmaintainers($data);
1182 $data->{owner} = '';
1183 } while (&getnextbug);
1185 &transcript("$gBug is not marked as having an owner.\n\n");
1189 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1192 $bug_affected{$ref} = 1;
1195 bug_unarchive(bug => $ref,
1196 transcript => \$transcript,
1197 affected_bugs => \%bug_affected,
1198 requester => $header{from},
1199 request_addr => $controlrequestaddr,
1206 transcript($transcript."\n");
1207 } elsif (m/^archive\s+#?(\d+)$/i) {
1210 $bug_affected{$ref} = 1;
1212 if (exists $data->{unarchived}) {
1216 bug_archive(bug => $ref,
1217 transcript => \$transcript,
1219 affected_bugs => \%bug_affected,
1220 requester => $header{from},
1221 request_addr => $controlrequestaddr,
1228 transcript($transcript."\n");
1231 transcript("$gBug $ref has not been archived previously\n\n");
1237 &transcript("Unknown command or malformed arguments to command.\n\n");
1239 if (++$unknowns >= 5) {
1240 &transcript("Too many unknown commands, stopping here.\n\n");
1245 if ($procline>$#bodylines) {
1246 &transcript(">\nEnd of message, stopping processing here.\n\n");
1248 if (!$ok && !quickabort) {
1250 &transcript("No commands successfully parsed; sending the help text(s).\n");
1255 &transcript("MC\n") if $dl>1;
1257 for $maint (keys %maintccreasons) {
1258 &transcript("MM|$maint|\n") if $dl>1;
1259 next if $maint eq $replyto;
1261 $reasonsref= $maintccreasons{$maint};
1262 &transcript("MY|$maint|\n") if $dl>2;
1263 for $p (sort keys %$reasonsref) {
1264 &transcript("MP|$p|\n") if $dl>2;
1265 $reasonstring.= ', ' if length($reasonstring);
1266 $reasonstring.= $p.' ' if length($p);
1267 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1269 if (length($reasonstring) > 40) {
1270 (substr $reasonstring, 37) = "...";
1272 $reasonstring = "" if (!defined($reasonstring));
1273 push(@maintccs,"$maint ($reasonstring)");
1274 push(@maintccaddrs,"$maint");
1279 &transcript("MC|@maintccs|\n") if $dl>2;
1280 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1284 for my $maint (keys %maintccreasons) {
1285 for my $package (keys %{$maintccreasons{$maint}}) {
1286 next unless length $package;
1287 $packagepr{$package} = 1;
1291 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1293 # Add Bcc's to subscribed bugs
1294 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1296 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1297 $header{'subject'} = "your mail";
1300 # Error text here advertises how many errors there were
1301 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1304 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1306 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1307 In-Reply-To: $header{'message-id'}
1308 References: $header{'message-id'}
1309 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1311 ${packagepr}X-$gProject-PR-Message: transcript
1313 ${transcript}Please contact me if you need assistance.
1316 (administrator, $gProject $gBugs database)
1320 $repliedshow= join(', ',$replyto,@maintccaddrs);
1321 # -1 is the service.in log
1322 &filelock("lock/-1");
1323 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1325 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1327 "<strong>Request received</strong> from <code>".
1328 html_escape($header{'from'})."</code>\n".
1329 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1331 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1332 close(AP) || &quit("open db-h/-1.log: $!");
1334 utime(time,time,"db-h");
1336 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1338 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1340 sub sendmailmessage {
1341 local ($message,@recips) = @_;
1342 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1343 send_mail_message(message => $message,
1344 recipients => \@recips,
1350 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1351 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1355 #sub unimplemented {
1356 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1360 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1362 if (@newmergelist) {
1363 eval "\$mvarvalue= \$$mvarname";
1364 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1367 "Values for \`$string' don't match:\n".
1368 " #$newmergelist[0] has \`$mvarvalue';\n".
1369 " #$ref has \`$svarvalue'\n"
1370 if $mvarvalue ne $svarvalue;
1372 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1374 eval "\$$mvarname= \$svarvalue";
1379 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1380 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1392 my %h = map { $_ => 1 } split ' ', $list;
1399 return join ' ', sort keys %h;
1402 # High-level bug manipulation calls
1403 # Do announcements themselves
1405 # Possible calling sequences:
1406 # setbug (returns 0)
1408 # setbug (returns 1)
1409 # &transcript(something)
1412 # setbug (returns 1)
1413 # $action= (something)
1415 # (modify s_* variables)
1416 # } while (getnextbug);
1419 &dlen("nochangebug");
1420 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1422 &endmerge if $manybugs;
1424 &dlex("nochangebug");
1428 &dlen("setbug $ref");
1429 if ($ref =~ m/^-\d+/) {
1430 if (!defined $clonebugs{$ref}) {
1432 &dlex("setbug => noclone");
1435 $ref = $clonebugs{$ref};
1437 $state eq 'idle' || die "$state ?";
1440 &dlex("setbug => 0s");
1444 if (!&checkpkglimit) {
1449 @thisbugmergelist= split(/ /,$data->{mergedwith});
1450 if (!@thisbugmergelist) {
1455 &dlex("setbug => 1s");
1464 &dlex("setbug => 0mc");
1468 $state= 'multiple'; $sref=$ref;
1469 &dlex("setbug => 1m");
1474 &dlen("getnextbug");
1475 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1477 if (!$manybugs || !@thisbugmergelist) {
1478 length($action) || die;
1479 &transcript("$action\n$extramessage\n");
1480 &endmerge if $manybugs;
1482 &dlex("getnextbug => 0");
1485 $ref= shift(@thisbugmergelist);
1486 &getbug || die "bug $ref disappeared";
1488 &dlex("getnextbug => 1");
1492 # Low-level bug-manipulation calls
1493 # Do no announcements
1495 # getbug (returns 0)
1497 # getbug (returns 1)
1501 # $action= (something)
1502 # getbug (returns 1)
1504 # getbug (returns 1)
1506 # [getbug (returns 0)]
1507 # &transcript("$action\n\n")
1510 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1511 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1515 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1516 &filelock('lock/merge');
1517 $mergelowstate='locked';
1523 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1525 $mergelowstate='idle';
1530 &dlen("getbug $ref");
1531 $lowstate eq 'idle' || die "$state ?";
1532 # Only use unmerged bugs here
1533 if (($data = &lockreadbug($ref,'db-h'))) {
1536 &dlex("getbug => 1");
1541 &dlex("getbug => 0");
1547 $lowstate eq 'open' || die "$state ?";
1554 &dlen("savebug $ref");
1555 $lowstate eq 'open' || die "$lowstate ?";
1556 length($action) || die;
1557 $ref == $sref || die "read $sref but saving $ref ?";
1558 append_action_to_log(bug => $ref,
1560 requester => $header{from},
1561 request_addr => $controlrequestaddr,
1565 unlockwritebug($ref, $data);
1572 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1577 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1581 print $_[0] if $debug;
1582 $transcript.= $_[0];
1589 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1590 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1606 sub sendtxthelpraw {
1607 local ($relpath,$description) = @_;
1609 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1610 while(<D>) { $doc.=$_; }
1612 &transcript("Sending $description in separate message.\n");
1613 &sendmailmessage(<<END.$doc,$replyto);
1614 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1616 Subject: $gProject $gBug help: $description
1617 References: $header{'message-id'}
1618 In-Reply-To: $header{'message-id'}
1619 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1621 X-$gProject-PR-Message: doc-text $relpath
1627 sub sendlynxdocraw {
1628 local ($relpath,$description) = @_;
1630 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1631 while(<L>) { $doc.=$_; }
1633 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1634 &transcript("Information ($description) is not available -\n".
1635 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1638 &transcript("Error getting $description (code $? $!):\n$doc\n");
1640 &transcript("Sending $description.\n");
1641 &sendmailmessage(<<END.$doc,$replyto);
1642 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1644 Subject: $gProject $gBugs information: $description
1645 References: $header{'message-id'}
1646 In-Reply-To: $header{'message-id'}
1647 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1649 X-$gProject-PR-Message: doc-html $relpath
1658 $maintccreasons{$cca}{''}{$ref}= 1;
1661 sub addmaintainers {
1662 # Data structure is:
1663 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1666 &ensuremaintainersloaded;
1667 $anymaintfound=0; $anymaintnotfound=0;
1668 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1670 $p =~ /([a-z0-9.+-]+)/;
1672 next unless defined $p;
1673 if (defined $gSubscriptionDomain) {
1674 if (defined($pkgsrc{$p})) {
1675 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1677 addbcc("$p\@$gSubscriptionDomain");
1680 if (defined $data->{severity} and defined $gStrongList and
1681 isstrongseverity($data->{severity})) {
1682 addbcc("$gStrongList\@$gListDomain");
1684 if (defined($maintainerof{$p})) {
1685 $addmaint= $maintainerof{$p};
1686 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1687 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1688 print "maintainer add >$p|$addmaint<\n" if $debug;
1690 print "maintainer none >$p<\n" if $debug;
1691 &transcript("Warning: Unknown package '$p'\n");
1692 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1693 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1697 if (length $data->{owner}) {
1698 $addmaint = $data->{owner};
1699 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1700 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1701 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1705 sub ensuremaintainersloaded {
1707 return if $maintainersloaded++;
1708 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1712 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1713 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1714 $maintainerof{$a}= $2;
1717 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1721 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1722 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1723 $maintainerof{$a}= $2;
1726 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1728 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1729 my ($a, $b) = ($1, $2);
1730 $pkgsrc{lc($a)} = $b;
1736 local ($wherefrom,$path,$description) = @_;
1737 if ($wherefrom eq "ftp.d.o") {
1738 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1740 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1741 &transcript("$description is not available.\n");
1744 &transcript("Error getting $description (code $? $!):\n$doc\n");
1747 } elsif ($wherefrom eq "local") {
1749 $doc = do { local $/; <P> };
1752 &transcript("internal errror: info files location unknown.\n");
1755 &transcript("Sending $description.\n");
1756 &sendmailmessage(<<END.$doc,$replyto);
1757 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1759 Subject: $gProject $gBugs information: $description
1760 References: $header{'message-id'}
1761 In-Reply-To: $header{'message-id'}
1762 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1764 X-$gProject-PR-Message: getinfo
1766 $description follows: