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 use Mail::RFC822::Address;
22 $lib_path = $gLibPath;
23 require "$lib_path/errorlib";
24 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
26 chdir("$gSpoolDir") || die "chdir spool: $!\n";
29 open DEBUG, ">/dev/null";
34 m/^[RC]\.\d+$/ || &quit("bad argument");
37 if (!rename("incoming/G$nn","incoming/P$nn")) {
38 $_=$!.''; m/no such file or directory/i && exit 0;
39 &quit("renaming to lock: $!");
42 open(M,"incoming/P$nn");
49 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
51 my $parser = new MIME::Parser;
52 mkdir "$gSpoolDir/mime.tmp", 0777;
53 $parser->output_under("$gSpoolDir/mime.tmp");
54 my $entity = eval { $parser->parse_data(join('',@log)) };
56 # header and decoded body respectively
57 my (@headerlines, @bodylines);
58 # Bug numbers to send e-mail to, hash so that we don't send to the
62 if ($entity and $entity->head->tags) {
63 @headerlines = @{$entity->head->header};
66 my $entity_body = getmailbody($entity);
67 @bodylines = $entity_body ? $entity_body->as_lines() : ();
70 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
72 for ($i = 0; $i <= $#msg; $i++) {
74 last unless length($_);
75 while ($msg[$i+1] =~ m/^\s/) {
79 push @headerlines, $_;
82 @bodylines = @msg[$i..$#msg];
86 $_ = decode_rfc1522($_);
88 print ">$_<\n" if $debug;
91 print ">$v=$_<\n" if $debug;
94 print "!>$_<\n" if $debug;
98 # Strip off RFC2440-style PGP clearsigning.
99 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
100 shift @bodylines while @bodylines and length $bodylines[0];
101 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
102 for my $findsig (0 .. $#bodylines) {
103 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
104 $#bodylines = $findsig - 1;
108 map { s/^- // } @bodylines;
111 grep(s/\s+$//,@bodylines);
113 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
115 if (defined $header{'resent-from'} && !defined $header{'from'}) {
116 $header{'from'} = $header{'resent-from'};
119 defined($header{'from'}) || &quit("no From header");
121 delete $header{'reply-to'}
122 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
124 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
125 $replyto = $header{'reply-to'};
127 $replyto = $header{'from'};
130 # This is an error counter which should be incremented every time there is an error.
132 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
134 &transcript("Processing commands for $controlrequestaddr:\n\n");
139 $mergelowstate= 'idle';
145 $user =~ s/^.*<(.*)>.*$/$1/;
146 $user =~ s/[(].*[)]//;
147 $user =~ s/^\s*(\S+)\s+.*$/$1/;
148 $user = "" unless (Debbugs::User::is_valid_user($user));
149 my $indicated_user = 0;
153 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
154 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
155 &transcript("You have been specifically excluded from using the\ncontrol interface.\n\n");
156 &transcript("Have a nice day\n\n.");
165 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
168 for ($procline=0; $procline<=$#bodylines; $procline++) {
169 $state eq 'idle' || print "$state ?\n";
170 $lowstate eq 'idle' || print "$lowstate ?\n";
171 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
173 &transcript("Stopping processing here.\n\n");
176 $_= $bodylines[$procline]; s/\s+$//;
178 &transcript("> $_\n");
181 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
182 &transcript("Stopping processing here.\n\n");
184 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
186 &transcript("Debug level $dl.\n\n");
187 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
189 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
190 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
192 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
193 "detailed logs for $gBug#$ref");
194 } elsif (m/^index(\s+full)?$/i) {
195 &transcript("This BTS function is currently disabled, sorry.\n\n");
197 $ok++; # well, it's not really ok, but it fixes #81224 :)
198 } elsif (m/^index-summary\s+by-package$/i) {
199 &transcript("This BTS function is currently disabled, sorry.\n\n");
201 $ok++; # well, it's not really ok, but it fixes #81224 :)
202 } elsif (m/^index-summary(\s+by-number)?$/i) {
203 &transcript("This BTS function is currently disabled, sorry.\n\n");
205 $ok++; # well, it's not really ok, but it fixes #81224 :)
206 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
207 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
208 } elsif (m/^index(\s+|-)maints?$/i) {
209 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
210 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
212 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
213 "$gBug list for maintainer \`$maint'");
215 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
217 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
218 "$gBug list for package $package");
220 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
221 &transcript("This BTS function is currently disabled, sorry.\n\n");
223 $ok++; # well, it's not really ok, but it fixes #81224 :)
224 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
225 &transcript("This BTS function is currently disabled, sorry.\n\n");
227 $ok++; # well, it's not really ok, but it fixes #81224 :)
228 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
229 &transcript("This BTS function is currently disabled, sorry.\n\n");
231 $ok++; # well, it's not really ok, but it fixes #81224 :)
232 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
233 # the following is basically a Debian-specific kludge, but who cares
235 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
236 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
237 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
239 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
240 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
241 &sendinfo("local", "$gConfigDir/$req", "$req file");
243 &transcript("Info file $req does not exist.\n\n");
245 } elsif (m/^help/i) {
249 } elsif (m/^refcard/i) {
250 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
251 } elsif (m/^subscribe/i) {
253 There is no $gProject $gBug mailing list. If you wish to review bug reports
254 please do so via http://$gWebDomain/ or ask this mail server
256 soon: MAILINGLISTS_TEXT
258 } elsif (m/^unsubscribe/i) {
260 soon: UNSUBSCRIBE_TEXT
261 soon: MAILINGLISTS_TEXT
263 } elsif (m/^user\s+(\S+)\s*$/i) {
265 if (Debbugs::User::is_valid_user($newuser)) {
266 my $olduser = ($user ne "" ? " (was $user)" : "");
267 &transcript("Setting user to $newuser$olduser.\n");
271 &transcript("Selected user id ($newuser) invalid, sorry\n");
276 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
279 my $hidden = ($2 ne "");
286 &transcript("No valid user selected\n");
290 if (not $indicated_user and defined $user) {
291 &transcript("User is $user\n");
294 while (++$procline <= $#bodylines) {
295 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
299 &transcript("> $bodylines[$procline]\n");
301 my ($o, $txt) = ($1, $2);
302 if ($#cats == -1 && $o eq "+") {
303 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
309 unless (ref($cats[-1]) eq "HASH") {
310 $cats[-1] = { "nam" => $cats[-1],
311 "pri" => [], "ttl" => [] };
314 my ($desc, $ord, $op);
315 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
316 $desc = $1; $ord = $3; $op = "";
317 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
318 $desc = $1; $ord = $3; $op = $4;
319 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
320 $desc = ""; $op = $1;
322 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
327 $ord = 999 unless defined $ord;
330 push @{$cats[-1]->{"pri"}}, $prefix . $op;
331 push @{$cats[-1]->{"ttl"}}, $desc;
332 push @ords, "$ord $catsec";
334 @cats[-1]->{"def"} = $desc;
335 push @ords, "$ord DEF";
338 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
339 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
340 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
341 } elsif ($o eq "*") {
344 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
345 $name = $1; $prefix = $3;
347 $name = $txt; $prefix = "";
352 # XXX: got @cats, now do something with it
353 my $u = Debbugs::User::get_user($user);
355 &transcript("Added usercategory $catname.\n\n");
356 $u->{"categories"}->{$catname} = [ @cats ];
358 push @{$u->{visible_cats}},$catname;
361 &transcript("Removed usercategory $catname.\n\n");
362 delete $u->{"categories"}->{$catname};
363 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
366 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
368 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
369 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
370 $ref = $clonebugs{$ref};
373 &transcript("No valid user selected\n");
377 if (not $indicated_user and defined $user) {
378 &transcript("User is $user\n");
383 Debbugs::User::read_usertags(\%ut, $user);
384 my @oldtags = (); my @newtags = (); my @badtags = ();
386 for my $t (split /[,\s]+/, $tags) {
387 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
394 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
397 for my $t (keys %chtags) {
398 $ut{$t} = [] unless defined $ut{$t};
400 for my $t (keys %ut) {
401 my %res = map { ($_, 1) } @{$ut{$t}};
402 push @oldtags, $t if defined $res{$ref};
403 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
404 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
405 : $addsubcode eq "=");
406 $res{$ref} = 1 if ($addop && defined $chtags{$t});
407 delete $res{$ref} if ($del);
408 push @newtags, $t if defined $res{$ref};
409 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
412 &transcript("There were no usertags set.\n");
414 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
416 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
417 Debbugs::User::write_usertags(\%ut, $user);
419 } elsif (!$control) {
421 Unknown command or malformed arguments to command.
422 (Use control\@$gEmailDomain to manipulate reports.)
426 if (++$unknowns >= 3) {
427 &transcript("Too many unknown commands, stopping here.\n\n");
430 #### "developer only" ones start here
431 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
434 $bug_affected{$ref}=1;
437 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
438 if (length($data->{done}) and not defined($version)) {
439 &transcript("$gBug is already closed, cannot re-close.\n\n");
444 "marked as fixed in version $version" :
446 ", send any further explanations to $data->{originator}";
448 &addmaintainers($data);
449 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
450 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
451 $data->{done}= $replyto;
452 my @keywords= split ' ', $data->{keywords};
453 if (grep $_ eq 'pending', @keywords) {
454 $extramessage= "Removed pending tag.\n";
455 $data->{keywords}= join ' ', grep $_ ne 'pending',
458 addfixedversions($data, $data->{package}, $version, 'binary');
461 From: $gMaintainerEmail ($gProject $gBug Tracking System)
462 To: $data->{originator}
463 Subject: $gBug#$ref acknowledged by developer
465 References: $header{'message-id'} $data->{msgid}
466 In-Reply-To: $data->{msgid}
467 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
468 Reply-To: $ref\@$gEmailDomain
469 X-$gProject-PR-Message: they-closed-control $ref
471 This is an automatic notification regarding your $gBug report
472 #$ref: $data->{subject},
473 which was filed against the $data->{package} package.
475 It has been marked as closed by one of the developers, namely
478 You should be hearing from them with a substantive response shortly,
479 in case you haven't already. If not, please contact them directly.
482 (administrator, $gProject $gBugs database)
485 &sendmailmessage($message,$data->{originator});
486 } while (&getnextbug);
489 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
491 $ref= $1; $newpackage= $2;
492 $bug_affected{$ref}=1;
494 $newpackage =~ y/A-Z/a-z/;
496 if (length($data->{package})) {
497 $action= "$gBug reassigned from package \`$data->{package}'".
498 " to \`$newpackage'.";
500 $action= "$gBug assigned to package \`$newpackage'.";
503 &addmaintainers($data);
504 $data->{package}= $newpackage;
505 $data->{found_versions}= [];
506 $data->{fixed_versions}= [];
507 # TODO: what if $newpackage is a source package?
508 addfoundversions($data, $data->{package}, $version, 'binary');
509 &addmaintainers($data);
510 } while (&getnextbug);
512 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
513 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
514 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
515 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
518 $bug_affected{$ref}=1;
520 if (@{$data->{fixed_versions}}) {
521 &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");
523 if (!length($data->{done})) {
524 &transcript("$gBug is already open, cannot reopen.\n\n");
528 $noriginator eq '' ? "$gBug reopened, originator not changed." :
529 "$gBug reopened, originator set to $noriginator.";
531 &addmaintainers($data);
532 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
533 $data->{fixed_versions}= [];
535 } while (&getnextbug);
538 } elsif (m{^found\s+\#?(-?\d+)
539 (?:\s+((?:$config{package_name_re}\/)?
540 $config{package_version_re}))?$}ix) {
545 if (!length($data->{done}) and not defined($version)) {
546 &transcript("$gBug is already open, cannot reopen.\n\n");
552 "$gBug marked as found in version $version." :
555 &addmaintainers($data);
556 # The 'done' field gets a bit weird with version
557 # tracking, because a bug may be closed by multiple
558 # people in different branches. Until we have something
559 # more flexible, we set it every time a bug is fixed,
560 # and clear it when a bug is found in a version greater
561 # than any version in which the bug is fixed or when
562 # a bug is found and there is no fixed version
563 if (defined $version) {
564 my ($version_only) = $version =~ m{([^/]+)$};
565 addfoundversions($data, $data->{package}, $version, 'binary');
566 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
567 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
568 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
569 $action = "$gBug marked as found in version $version and reopened."
570 if length $data->{done};
574 # Versionless found; assume old-style "not fixed at
576 $data->{fixed_versions} = [];
579 } while (&getnextbug);
582 } elsif (m[^notfound\s+\#?(-?\d+)
583 (?:\s+(?:$config{package_name_re}\/)?
584 ($config{package_version_re}))$]ix) {
589 $action= "$gBug no longer marked as found in version $version.";
590 if (length($data->{done})) {
591 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
594 &addmaintainers($data);
595 removefoundversions($data, $data->{package}, $version, 'binary');
596 } while (&getnextbug);
599 elsif (m[^fixed\s+\#?(-?\d+)\s+
600 ((?:$config{package_name_re}\/)?
601 $config{package_version_re})\s*$]ix) {
608 "$gBug marked as fixed in version $version." :
611 &addmaintainers($data);
612 addfixedversions($data, $data->{package}, $version, 'binary');
613 } while (&getnextbug);
616 elsif (m[^notfixed\s+\#?(-?\d+)\s+
617 ((?:$config{package_name_re}\/)?
618 $config{package_version_re})\s*$]ix) {
625 "$gBug no longer marked as fixed in version $version." :
628 &addmaintainers($data);
629 removefixedversions($data, $data->{package}, $version, 'binary');
630 } while (&getnextbug);
633 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
634 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
637 $bug_affected{$ref}=1;
638 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
639 $ref = $clonebugs{$ref};
641 if (not Mail::RFC822::Address::valid($newsubmitter)) {
642 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
646 if (&checkpkglimit) {
648 &addmaintainers($data);
649 $oldsubmitter= $data->{originator};
650 $data->{originator}= $newsubmitter;
651 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
653 &transcript("$action\n");
654 if (length($data->{done})) {
655 &transcript("(By the way, that $gBug is currently marked as done.)\n");
659 From: $gMaintainerEmail ($gProject $gBug Tracking System)
661 Subject: $gBug#$ref submitter address changed
663 References: $header{'message-id'} $data->{msgid}
664 In-Reply-To: $data->{msgid}
665 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
666 Reply-To: $ref\@$gEmailDomain
667 X-$gProject-PR-Message: submitter-changed $ref
669 The submitter address recorded for your $gBug report
670 #$ref: $data->{subject}
673 The old submitter address for this report was
675 The new submitter address is
678 This change was made by
680 If it was incorrect, please contact them directly.
683 (administrator, $gProject $gBugs database)
686 &sendmailmessage($message,$oldsubmitter);
693 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
695 $ref= $1; $whereto= $2;
696 $bug_affected{$ref}=1;
698 if (length($data->{forwarded})) {
699 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
701 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
703 if (length($data->{done})) {
704 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
707 &addmaintainers($data);
708 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
709 &addccaddress("$gForwardList\@$gListDomain");
711 $data->{forwarded}= $whereto;
712 } while (&getnextbug);
714 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
717 $bug_affected{$ref}=1;
719 if (!length($data->{forwarded})) {
720 &transcript("$gBug is not marked as having been forwarded.\n\n");
723 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
725 &addmaintainers($data);
726 $data->{forwarded}= '';
727 } while (&getnextbug);
730 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
731 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
734 $bug_affected{$ref}=1;
736 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
737 &transcript("Severity level \`$newseverity' is not known.\n".
738 "Recognized are: $gShowSeverities.\n\n");
740 } elsif (exists $gObsoleteSeverities{$newseverity}) {
741 &transcript("Severity level \`$newseverity' is obsolete. " .
742 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
745 $printseverity= $data->{severity};
746 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
747 $action= "Severity set to \`$newseverity' from \`$printseverity'";
749 &addmaintainers($data);
750 if (defined $gStrongList and isstrongseverity($newseverity)) {
751 addbcc("$gStrongList\@$gListDomain");
753 $data->{severity}= $newseverity;
754 } while (&getnextbug);
756 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
758 $ref = $1; $addsubcode = $3; $tags = $4;
759 $bug_affected{$ref}=1;
761 if (defined $addsubcode) {
762 $addsub = "sub" if ($addsubcode eq "-");
763 $addsub = "add" if ($addsubcode eq "+");
764 $addsub = "set" if ($addsubcode eq "=");
768 foreach my $t (split /[\s,]+/, $tags) {
769 if (!grep($_ eq $t, @gTags)) {
776 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
777 "Recognized are: ".join(' ', @gTags).".\n\n");
781 if ($data->{keywords} eq '') {
782 &transcript("There were no tags set.\n");
784 &transcript("Tags were: $data->{keywords}\n");
786 if ($addsub eq "set") {
787 $action= "Tags set to: " . join(", ", @okaytags);
788 } elsif ($addsub eq "add") {
789 $action= "Tags added: " . join(", ", @okaytags);
790 } elsif ($addsub eq "sub") {
791 $action= "Tags removed: " . join(", ", @okaytags);
794 &addmaintainers($data);
795 $data->{keywords} = '' if ($addsub eq "set");
796 # Allow removing obsolete tags.
797 if ($addsub eq "sub") {
798 foreach my $t (@badtags) {
799 $data->{keywords} = join ' ', grep $_ ne $t,
800 split ' ', $data->{keywords};
803 # Now process all other additions and subtractions.
804 foreach my $t (@okaytags) {
805 $data->{keywords} = join ' ', grep $_ ne $t,
806 split ' ', $data->{keywords};
807 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
809 $data->{keywords} =~ s/\s*$//;
810 } while (&getnextbug);
812 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
814 my $bugnum = $2; my $blockers = $4;
816 $addsub = "sub" if ($1 eq "un");
817 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
818 $bugnum = $clonebugs{$bugnum};
823 foreach my $b (split /[\s,]+/, $blockers) {
827 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
828 $ref = $clonebugs{$ref};
832 push @okayblockers, $ref;
834 # add to the list all bugs that are merged with $b,
835 # because all of their data must be kept in sync
836 @thisbugmergelist= split(/ /,$data->{mergedwith});
839 foreach $ref (@thisbugmergelist) {
841 push @okayblockers, $ref;
848 push @badblockers, $ref;
852 push @badblockers, $b;
856 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
862 if ($data->{blockedby} eq '') {
863 &transcript("Was not blocked by any bugs.\n");
865 &transcript("Was blocked by: $data->{blockedby}\n");
867 if ($addsub eq "set") {
868 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
869 } elsif ($addsub eq "add") {
870 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
871 } elsif ($addsub eq "sub") {
872 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
877 &addmaintainers($data);
878 my @oldblockerlist = split ' ', $data->{blockedby};
879 $data->{blockedby} = '' if ($addsub eq "set");
880 foreach my $b (@okayblockers) {
881 $data->{blockedby} = manipset($data->{blockedby}, $b,
885 foreach my $b (@oldblockerlist) {
886 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
887 push @{$removedblocks{$b}}, $ref;
890 foreach my $b (split ' ', $data->{blockedby}) {
891 if (! grep { $_ eq $b } @oldblockerlist) {
892 push @{$addedblocks{$b}}, $ref;
895 } while (&getnextbug);
897 # Now that the blockedby data is updated, change blocks data
898 # to match the changes.
899 foreach $ref (keys %addedblocks) {
901 foreach my $b (@{$addedblocks{$ref}}) {
902 $data->{blocks} = manipset($data->{blocks}, $b, 1);
907 foreach $ref (keys %removedblocks) {
909 foreach my $b (@{$removedblocks{$ref}}) {
910 $data->{blocks} = manipset($data->{blocks}, $b, 0);
916 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
918 $ref= $1; $newtitle= $2;
919 $bug_affected{$ref}=1;
920 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
921 $ref = $clonebugs{$ref};
924 if (&checkpkglimit) {
926 &addmaintainers($data);
927 my $oldtitle = $data->{subject};
928 $data->{subject}= $newtitle;
929 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
931 &transcript("$action\n");
932 if (length($data->{done})) {
933 &transcript("(By the way, that $gBug is currently marked as done.)\n");
942 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
945 $bug_affected{$ref} = 1;
947 if (!length($data->{mergedwith})) {
948 &transcript("$gBug is not marked as being merged with any others.\n\n");
951 $mergelowstate eq 'locked' || die "$mergelowstate ?";
952 $action= "Disconnected #$ref from all other report(s).";
953 @newmergelist= split(/ /,$data->{mergedwith});
955 @bug_affected{@newmergelist} = 1 x @newmergelist;
957 &addmaintainers($data);
958 $data->{mergedwith}= ($ref == $discref) ? ''
959 : join(' ',grep($_ ne $ref,@newmergelist));
960 } while (&getnextbug);
963 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
965 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
966 my @newmergelist= ();
971 while (defined($ref= shift(@tomerge))) {
972 &transcript("D| checking merge $ref\n") if $dl;
974 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
975 $ref = $clonebugs{$ref};
977 next if grep($_ == $ref,@newmergelist);
978 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
979 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
981 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
983 &checkmatch('package','m_package',$data->{package},@newmergelist);
984 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
985 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
986 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
987 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
988 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
989 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
990 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
991 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
992 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
993 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
994 if (length($mismatch)) {
995 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
998 &cancelbug; @newmergelist=(); last;
1000 push(@newmergelist,$ref);
1001 push(@tomerge,split(/ /,$data->{mergedwith}));
1004 if (@newmergelist) {
1005 @newmergelist= sort { $a <=> $b } @newmergelist;
1006 $action= "Merged @newmergelist.";
1007 delete @fixed{keys %found};
1008 for $ref (@newmergelist) {
1009 &getbug || die "huh ? $gBug $ref disappeared during merge";
1010 &addmaintainers($data);
1011 @bug_affected{@newmergelist} = 1 x @newmergelist;
1012 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1013 $data->{keywords}= join(' ', keys %tags);
1014 $data->{found_versions}= [sort keys %found];
1015 $data->{fixed_versions}= [sort keys %fixed];
1018 &transcript("$action\n\n");
1021 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1023 my @temp = split /\s+\#?/,$1;
1024 my $master_bug = shift @temp;
1025 my $master_bug_data;
1026 my @tomerge = sort { $a <=> $b } @temp;
1027 unshift @tomerge,$master_bug;
1028 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1029 my @newmergelist= ();
1033 # Here we try to do the right thing.
1034 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1035 # If not, we discard the found and fixed.
1036 # Everything else we set to the values of the first bug.
1038 while (defined($ref= shift(@tomerge))) {
1039 &transcript("D| checking merge $ref\n") if $dl;
1041 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1042 $ref = $clonebugs{$ref};
1044 next if grep($_ == $ref,@newmergelist);
1045 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1046 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1048 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1049 $master_bug_data = $data if not defined $master_bug_data;
1050 if ($data->{package} ne $master_bug_data->{package}) {
1051 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1052 "$gBug $ref is not in the same package as $master_bug\n");
1054 &cancelbug; @newmergelist=(); last;
1056 for my $t (split /\s+/,$data->{keywords}) {
1059 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1060 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1061 push(@newmergelist,$ref);
1062 push(@tomerge,split(/ /,$data->{mergedwith}));
1065 if (@newmergelist) {
1066 @newmergelist= sort { $a <=> $b } @newmergelist;
1067 $action= "Forcibly Merged @newmergelist.";
1068 delete @fixed{keys %found};
1069 for $ref (@newmergelist) {
1070 &getbug || die "huh ? $gBug $ref disappeared during merge";
1071 &addmaintainers($data);
1072 @bug_affected{@newmergelist} = 1 x @newmergelist;
1073 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1074 $data->{keywords}= join(' ', keys %tags);
1075 $data->{found_versions}= [sort keys %found];
1076 $data->{fixed_versions}= [sort keys %fixed];
1077 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1078 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1081 &transcript("$action\n\n");
1084 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1088 @newclonedids = split /\s+/, $2;
1089 $newbugsneeded = scalar(@newclonedids);
1092 $bug_affected{$ref} = 1;
1094 if (length($data->{mergedwith})) {
1095 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1099 &filelock("nextnumber.lock");
1100 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1101 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1102 $firstref= $v+0; $v += $newbugsneeded;
1103 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1106 $lastref = $firstref + $newbugsneeded - 1;
1108 if ($newbugsneeded == 1) {
1109 $action= "$gBug $origref cloned as bug $firstref.";
1111 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1114 my $blocks = $data->{blocks};
1115 my $blockedby = $data->{blockedby};
1118 my $ohash = get_hashname($origref);
1119 my $clone = $firstref;
1120 @bug_affected{@newclonedids} = 1 x @newclonedids;
1121 for $newclonedid (@newclonedids) {
1122 $clonebugs{$newclonedid} = $clone;
1124 my $hash = get_hashname($clone);
1125 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1126 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1127 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1128 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1129 &bughook('new', $clone, $data);
1131 # Update blocking info of bugs blocked by or blocking the
1133 foreach $ref (split ' ', $blocks) {
1135 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1138 foreach $ref (split ' ', $blockedby) {
1140 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1148 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1150 my @pkgs = split /\s+/, $1;
1151 if (scalar(@pkgs) > 0) {
1152 %limit_pkgs = map { ($_, 1) } @pkgs;
1153 &transcript("Ignoring bugs not assigned to: " .
1154 join(" ", keys(%limit_pkgs)) . "\n\n");
1157 &transcript("Not ignoring any bugs.\n\n");
1159 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1160 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1163 $bug_affected{$ref} = 1;
1165 if (length $data->{owner}) {
1166 $action = "Owner changed from $data->{owner} to $newowner.";
1168 $action = "Owner recorded as $newowner.";
1170 if (length $data->{done}) {
1171 $extramessage = "(By the way, this $gBug is currently " .
1172 "marked as done.)\n";
1175 &addmaintainers($data);
1176 $data->{owner} = $newowner;
1177 } while (&getnextbug);
1179 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1182 $bug_affected{$ref} = 1;
1184 if (length $data->{owner}) {
1185 $action = "Removed annotation that $gBug was owned by " .
1188 &addmaintainers($data);
1189 $data->{owner} = '';
1190 } while (&getnextbug);
1192 &transcript("$gBug is not marked as having an owner.\n\n");
1196 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1199 $bug_affected{$ref} = 1;
1202 bug_unarchive(bug => $ref,
1203 transcript => \$transcript,
1204 affected_bugs => \%bug_affected,
1205 requester => $header{from},
1206 request_addr => $controlrequestaddr,
1213 transcript($transcript."\n");
1214 } elsif (m/^archive\s+#?(\d+)$/i) {
1217 $bug_affected{$ref} = 1;
1219 if (exists $data->{unarchived}) {
1223 bug_archive(bug => $ref,
1224 transcript => \$transcript,
1226 affected_bugs => \%bug_affected,
1227 requester => $header{from},
1228 request_addr => $controlrequestaddr,
1235 transcript($transcript."\n");
1238 transcript("$gBug $ref has not been archived previously\n\n");
1244 &transcript("Unknown command or malformed arguments to command.\n\n");
1246 if (++$unknowns >= 5) {
1247 &transcript("Too many unknown commands, stopping here.\n\n");
1252 if ($procline>$#bodylines) {
1253 &transcript(">\nEnd of message, stopping processing here.\n\n");
1255 if (!$ok && !quickabort) {
1257 &transcript("No commands successfully parsed; sending the help text(s).\n");
1262 &transcript("MC\n") if $dl>1;
1264 for $maint (keys %maintccreasons) {
1265 &transcript("MM|$maint|\n") if $dl>1;
1266 next if $maint eq $replyto;
1268 $reasonsref= $maintccreasons{$maint};
1269 &transcript("MY|$maint|\n") if $dl>2;
1270 for $p (sort keys %$reasonsref) {
1271 &transcript("MP|$p|\n") if $dl>2;
1272 $reasonstring.= ', ' if length($reasonstring);
1273 $reasonstring.= $p.' ' if length($p);
1274 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1276 if (length($reasonstring) > 40) {
1277 (substr $reasonstring, 37) = "...";
1279 $reasonstring = "" if (!defined($reasonstring));
1280 push(@maintccs,"$maint ($reasonstring)");
1281 push(@maintccaddrs,"$maint");
1286 &transcript("MC|@maintccs|\n") if $dl>2;
1287 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1291 for my $maint (keys %maintccreasons) {
1292 for my $package (keys %{$maintccreasons{$maint}}) {
1293 next unless length $package;
1294 $packagepr{$package} = 1;
1298 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1300 # Add Bcc's to subscribed bugs
1301 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1303 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1304 $header{'subject'} = "your mail";
1307 # Error text here advertises how many errors there were
1308 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1311 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1313 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1314 In-Reply-To: $header{'message-id'}
1315 References: $header{'message-id'}
1316 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1318 ${packagepr}X-$gProject-PR-Message: transcript
1320 ${transcript}Please contact me if you need assistance.
1323 (administrator, $gProject $gBugs database)
1327 $repliedshow= join(', ',$replyto,@maintccaddrs);
1328 # -1 is the service.in log
1329 &filelock("lock/-1");
1330 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1332 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1334 "<strong>Request received</strong> from <code>".
1335 html_escape($header{'from'})."</code>\n".
1336 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1338 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1339 close(AP) || &quit("open db-h/-1.log: $!");
1341 utime(time,time,"db-h");
1343 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1345 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1347 sub sendmailmessage {
1348 local ($message,@recips) = @_;
1349 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1350 send_mail_message(message => $message,
1351 recipients => \@recips,
1357 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1358 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1362 #sub unimplemented {
1363 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1367 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1369 if (@newmergelist) {
1370 eval "\$mvarvalue= \$$mvarname";
1371 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1374 "Values for \`$string' don't match:\n".
1375 " #$newmergelist[0] has \`$mvarvalue';\n".
1376 " #$ref has \`$svarvalue'\n"
1377 if $mvarvalue ne $svarvalue;
1379 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1381 eval "\$$mvarname= \$svarvalue";
1386 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1387 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1399 my %h = map { $_ => 1 } split ' ', $list;
1406 return join ' ', sort keys %h;
1409 # High-level bug manipulation calls
1410 # Do announcements themselves
1412 # Possible calling sequences:
1413 # setbug (returns 0)
1415 # setbug (returns 1)
1416 # &transcript(something)
1419 # setbug (returns 1)
1420 # $action= (something)
1422 # (modify s_* variables)
1423 # } while (getnextbug);
1426 &dlen("nochangebug");
1427 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1429 &endmerge if $manybugs;
1431 &dlex("nochangebug");
1435 &dlen("setbug $ref");
1436 if ($ref =~ m/^-\d+/) {
1437 if (!defined $clonebugs{$ref}) {
1439 &dlex("setbug => noclone");
1442 $ref = $clonebugs{$ref};
1444 $state eq 'idle' || die "$state ?";
1447 &dlex("setbug => 0s");
1451 if (!&checkpkglimit) {
1456 @thisbugmergelist= split(/ /,$data->{mergedwith});
1457 if (!@thisbugmergelist) {
1462 &dlex("setbug => 1s");
1471 &dlex("setbug => 0mc");
1475 $state= 'multiple'; $sref=$ref;
1476 &dlex("setbug => 1m");
1481 &dlen("getnextbug");
1482 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1484 if (!$manybugs || !@thisbugmergelist) {
1485 length($action) || die;
1486 &transcript("$action\n$extramessage\n");
1487 &endmerge if $manybugs;
1489 &dlex("getnextbug => 0");
1492 $ref= shift(@thisbugmergelist);
1493 &getbug || die "bug $ref disappeared";
1495 &dlex("getnextbug => 1");
1499 # Low-level bug-manipulation calls
1500 # Do no announcements
1502 # getbug (returns 0)
1504 # getbug (returns 1)
1508 # $action= (something)
1509 # getbug (returns 1)
1511 # getbug (returns 1)
1513 # [getbug (returns 0)]
1514 # &transcript("$action\n\n")
1517 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1518 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1522 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1523 &filelock('lock/merge');
1524 $mergelowstate='locked';
1530 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1532 $mergelowstate='idle';
1537 &dlen("getbug $ref");
1538 $lowstate eq 'idle' || die "$state ?";
1539 # Only use unmerged bugs here
1540 if (($data = &lockreadbug($ref,'db-h'))) {
1543 &dlex("getbug => 1");
1548 &dlex("getbug => 0");
1554 $lowstate eq 'open' || die "$state ?";
1561 &dlen("savebug $ref");
1562 $lowstate eq 'open' || die "$lowstate ?";
1563 length($action) || die;
1564 $ref == $sref || die "read $sref but saving $ref ?";
1565 append_action_to_log(bug => $ref,
1567 requester => $header{from},
1568 request_addr => $controlrequestaddr,
1572 unlockwritebug($ref, $data);
1579 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1584 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1588 print $_[0] if $debug;
1589 $transcript.= $_[0];
1596 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1597 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1613 sub sendtxthelpraw {
1614 local ($relpath,$description) = @_;
1616 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1617 while(<D>) { $doc.=$_; }
1619 &transcript("Sending $description in separate message.\n");
1620 &sendmailmessage(<<END.$doc,$replyto);
1621 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1623 Subject: $gProject $gBug help: $description
1624 References: $header{'message-id'}
1625 In-Reply-To: $header{'message-id'}
1626 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1628 X-$gProject-PR-Message: doc-text $relpath
1634 sub sendlynxdocraw {
1635 local ($relpath,$description) = @_;
1637 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1638 while(<L>) { $doc.=$_; }
1640 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1641 &transcript("Information ($description) is not available -\n".
1642 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1645 &transcript("Error getting $description (code $? $!):\n$doc\n");
1647 &transcript("Sending $description.\n");
1648 &sendmailmessage(<<END.$doc,$replyto);
1649 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1651 Subject: $gProject $gBugs information: $description
1652 References: $header{'message-id'}
1653 In-Reply-To: $header{'message-id'}
1654 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1656 X-$gProject-PR-Message: doc-html $relpath
1665 $maintccreasons{$cca}{''}{$ref}= 1;
1668 sub addmaintainers {
1669 # Data structure is:
1670 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1673 &ensuremaintainersloaded;
1674 $anymaintfound=0; $anymaintnotfound=0;
1675 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1677 $p =~ /([a-z0-9.+-]+)/;
1679 next unless defined $p;
1680 if (defined $gSubscriptionDomain) {
1681 if (defined($pkgsrc{$p})) {
1682 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1684 addbcc("$p\@$gSubscriptionDomain");
1687 if (defined $data->{severity} and defined $gStrongList and
1688 isstrongseverity($data->{severity})) {
1689 addbcc("$gStrongList\@$gListDomain");
1691 if (defined($maintainerof{$p})) {
1692 $addmaint= $maintainerof{$p};
1693 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1694 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1695 print "maintainer add >$p|$addmaint<\n" if $debug;
1697 print "maintainer none >$p<\n" if $debug;
1698 &transcript("Warning: Unknown package '$p'\n");
1699 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1700 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1704 if (length $data->{owner}) {
1705 $addmaint = $data->{owner};
1706 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1707 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1708 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1712 sub ensuremaintainersloaded {
1714 return if $maintainersloaded++;
1715 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1719 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1720 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1721 $maintainerof{$a}= $2;
1724 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1728 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1729 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1730 $maintainerof{$a}= $2;
1733 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1735 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1736 my ($a, $b) = ($1, $2);
1737 $pkgsrc{lc($a)} = $b;
1743 local ($wherefrom,$path,$description) = @_;
1744 if ($wherefrom eq "ftp.d.o") {
1745 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1747 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1748 &transcript("$description is not available.\n");
1751 &transcript("Error getting $description (code $? $!):\n$doc\n");
1754 } elsif ($wherefrom eq "local") {
1756 $doc = do { local $/; <P> };
1759 &transcript("internal errror: info files location unknown.\n");
1762 &transcript("Sending $description.\n");
1763 &sendmailmessage(<<END.$doc,$replyto);
1764 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1766 Subject: $gProject $gBugs information: $description
1767 References: $header{'message-id'}
1768 In-Reply-To: $header{'message-id'}
1769 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1771 X-$gProject-PR-Message: getinfo
1773 $description follows: