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);
19 use Debbugs::Text qw(:templates);
21 use Mail::RFC822::Address;
23 $lib_path = $gLibPath;
24 require "$lib_path/errorlib";
25 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
27 chdir("$gSpoolDir") || die "chdir spool: $!\n";
30 open DEBUG, ">/dev/null";
35 m/^[RC]\.\d+$/ || &quit("bad argument");
38 if (!rename("incoming/G$nn","incoming/P$nn")) {
39 $_=$!.''; m/no such file or directory/i && exit 0;
40 &quit("renaming to lock: $!");
43 open(M,"incoming/P$nn");
50 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
52 my $parser = new MIME::Parser;
53 mkdir "$gSpoolDir/mime.tmp", 0777;
54 $parser->output_under("$gSpoolDir/mime.tmp");
55 my $entity = eval { $parser->parse_data(join('',@log)) };
57 # header and decoded body respectively
58 my (@headerlines, @bodylines);
59 # Bug numbers to send e-mail to, hash so that we don't send to the
63 if ($entity and $entity->head->tags) {
64 # Use map instead of chomp to also kill \r.
65 @headerlines = map {s/\r?\n?$//; $_;}
66 @{$entity->head->header};
68 my $entity_body = getmailbody($entity);
69 @bodylines = map {s/\r?\n$//; $_;}
70 $entity_body ? $entity_body->as_lines() : ();
72 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
74 for ($i = 0; $i <= $#msg; $i++) {
76 last unless length($_);
77 while ($msg[$i+1] =~ m/^\s/) {
81 push @headerlines, $_;
84 @bodylines = @msg[$i..$#msg];
88 $_ = decode_rfc1522($_);
90 print ">$_<\n" if $debug;
93 print ">$v=$_<\n" if $debug;
96 print "!>$_<\n" if $debug;
100 # Strip off RFC2440-style PGP clearsigning.
101 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
102 shift @bodylines while @bodylines and length $bodylines[0];
103 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
104 for my $findsig (0 .. $#bodylines) {
105 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
106 $#bodylines = $findsig - 1;
110 map { s/^- // } @bodylines;
113 grep(s/\s+$//,@bodylines);
115 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
117 if (defined $header{'resent-from'} && !defined $header{'from'}) {
118 $header{'from'} = $header{'resent-from'};
121 defined($header{'from'}) || &quit("no From header");
123 delete $header{'reply-to'}
124 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
126 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
127 $replyto = $header{'reply-to'};
129 $replyto = $header{'from'};
132 # This is an error counter which should be incremented every time there is an error.
134 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
136 &transcript("Processing commands for $controlrequestaddr:\n\n");
141 $mergelowstate= 'idle';
147 $user =~ s/^.*<(.*)>.*$/$1/;
148 $user =~ s/[(].*[)]//;
149 $user =~ s/^\s*(\S+)\s+.*$/$1/;
150 $user = "" unless (Debbugs::User::is_valid_user($user));
151 my $indicated_user = 0;
155 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
156 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
157 &transcript(fill_template('mail/excluded_from_control'));
166 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
169 for ($procline=0; $procline<=$#bodylines; $procline++) {
170 $state eq 'idle' || print "$state ?\n";
171 $lowstate eq 'idle' || print "$lowstate ?\n";
172 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
174 &transcript("Stopping processing here.\n\n");
177 $_= $bodylines[$procline]; s/\s+$//;
179 &transcript("> $_\n");
182 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
183 &transcript("Stopping processing here.\n\n");
185 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
187 &transcript("Debug level $dl.\n\n");
188 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
190 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
191 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
193 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
194 "detailed logs for $gBug#$ref");
195 } elsif (m/^index(\s+full)?$/i) {
196 &transcript("This BTS function is currently disabled, sorry.\n\n");
198 $ok++; # well, it's not really ok, but it fixes #81224 :)
199 } elsif (m/^index-summary\s+by-package$/i) {
200 &transcript("This BTS function is currently disabled, sorry.\n\n");
202 $ok++; # well, it's not really ok, but it fixes #81224 :)
203 } elsif (m/^index-summary(\s+by-number)?$/i) {
204 &transcript("This BTS function is currently disabled, sorry.\n\n");
206 $ok++; # well, it's not really ok, but it fixes #81224 :)
207 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
208 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
209 } elsif (m/^index(\s+|-)maints?$/i) {
210 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
211 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
213 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
214 "$gBug list for maintainer \`$maint'");
216 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
218 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
219 "$gBug list for package $package");
221 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
222 &transcript("This BTS function is currently disabled, sorry.\n\n");
224 $ok++; # well, it's not really ok, but it fixes #81224 :)
225 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
226 &transcript("This BTS function is currently disabled, sorry.\n\n");
228 $ok++; # well, it's not really ok, but it fixes #81224 :)
229 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
230 &transcript("This BTS function is currently disabled, sorry.\n\n");
232 $ok++; # well, it's not really ok, but it fixes #81224 :)
233 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
234 # the following is basically a Debian-specific kludge, but who cares
236 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
237 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
238 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
240 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
241 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
242 &sendinfo("local", "$gConfigDir/$req", "$req file");
244 &transcript("Info file $req does not exist.\n\n");
246 } elsif (m/^help/i) {
250 } elsif (m/^refcard/i) {
251 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
252 } elsif (m/^subscribe/i) {
254 There is no $gProject $gBug mailing list. If you wish to review bug reports
255 please do so via http://$gWebDomain/ or ask this mail server
257 soon: MAILINGLISTS_TEXT
259 } elsif (m/^unsubscribe/i) {
261 soon: UNSUBSCRIBE_TEXT
262 soon: MAILINGLISTS_TEXT
264 } elsif (m/^user\s+(\S+)\s*$/i) {
266 if (Debbugs::User::is_valid_user($newuser)) {
267 my $olduser = ($user ne "" ? " (was $user)" : "");
268 &transcript("Setting user to $newuser$olduser.\n");
272 &transcript("Selected user id ($newuser) invalid, sorry\n");
277 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
280 my $hidden = ($2 ne "");
287 &transcript("No valid user selected\n");
291 if (not $indicated_user and defined $user) {
292 &transcript("User is $user\n");
295 while (++$procline <= $#bodylines) {
296 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
300 &transcript("> $bodylines[$procline]\n");
302 my ($o, $txt) = ($1, $2);
303 if ($#cats == -1 && $o eq "+") {
304 &transcript("User defined category specification must start with a category name. Skipping.\n\n");
310 unless (ref($cats[-1]) eq "HASH") {
311 $cats[-1] = { "nam" => $cats[-1],
312 "pri" => [], "ttl" => [] };
315 my ($desc, $ord, $op);
316 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
317 $desc = $1; $ord = $3; $op = "";
318 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
319 $desc = $1; $ord = $3; $op = $4;
320 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
321 $desc = ""; $op = $1;
323 &transcript("Unrecognised syntax for category section. Skipping.\n\n");
328 $ord = 999 unless defined $ord;
331 push @{$cats[-1]->{"pri"}}, $prefix . $op;
332 push @{$cats[-1]->{"ttl"}}, $desc;
333 push @ords, "$ord $catsec";
335 @cats[-1]->{"def"} = $desc;
336 push @ords, "$ord DEF";
339 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
340 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
341 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
342 } elsif ($o eq "*") {
345 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
346 $name = $1; $prefix = $3;
348 $name = $txt; $prefix = "";
353 # XXX: got @cats, now do something with it
354 my $u = Debbugs::User::get_user($user);
356 &transcript("Added usercategory $catname.\n\n");
357 $u->{"categories"}->{$catname} = [ @cats ];
359 push @{$u->{visible_cats}},$catname;
362 &transcript("Removed usercategory $catname.\n\n");
363 delete $u->{"categories"}->{$catname};
364 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
367 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
369 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
370 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
371 $ref = $clonebugs{$ref};
374 &transcript("No valid user selected\n");
378 if (not $indicated_user and defined $user) {
379 &transcript("User is $user\n");
384 Debbugs::User::read_usertags(\%ut, $user);
385 my @oldtags = (); my @newtags = (); my @badtags = ();
387 for my $t (split /[,\s]+/, $tags) {
388 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
395 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
398 for my $t (keys %chtags) {
399 $ut{$t} = [] unless defined $ut{$t};
401 for my $t (keys %ut) {
402 my %res = map { ($_, 1) } @{$ut{$t}};
403 push @oldtags, $t if defined $res{$ref};
404 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
405 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
406 : $addsubcode eq "=");
407 $res{$ref} = 1 if ($addop && defined $chtags{$t});
408 delete $res{$ref} if ($del);
409 push @newtags, $t if defined $res{$ref};
410 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
413 &transcript("There were no usertags set.\n");
415 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
417 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
418 Debbugs::User::write_usertags(\%ut, $user);
420 } elsif (!$control) {
422 Unknown command or malformed arguments to command.
423 (Use control\@$gEmailDomain to manipulate reports.)
427 if (++$unknowns >= 3) {
428 &transcript("Too many unknown commands, stopping here.\n\n");
431 #### "developer only" ones start here
432 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
435 $bug_affected{$ref}=1;
438 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
439 if (length($data->{done}) and not defined($version)) {
440 &transcript("$gBug is already closed, cannot re-close.\n\n");
445 "marked as fixed in version $version" :
447 ", send any further explanations to $data->{originator}";
449 &addmaintainers($data);
450 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
451 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
452 $data->{done}= $replyto;
453 my @keywords= split ' ', $data->{keywords};
454 if (grep $_ eq 'pending', @keywords) {
455 $extramessage= "Removed pending tag.\n";
456 $data->{keywords}= join ' ', grep $_ ne 'pending',
459 addfixedversions($data, $data->{package}, $version, 'binary');
462 From: $gMaintainerEmail ($gProject $gBug Tracking System)
463 To: $data->{originator}
464 Subject: $gBug#$ref acknowledged by developer
466 References: $header{'message-id'} $data->{msgid}
467 In-Reply-To: $data->{msgid}
468 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
469 Reply-To: $ref\@$gEmailDomain
470 X-$gProject-PR-Message: they-closed-control $ref
472 This is an automatic notification regarding your $gBug report
473 #$ref: $data->{subject},
474 which was filed against the $data->{package} package.
476 It has been marked as closed by one of the developers, namely
479 You should be hearing from them with a substantive response shortly,
480 in case you haven't already. If not, please contact them directly.
483 (administrator, $gProject $gBugs database)
486 &sendmailmessage($message,$data->{originator});
487 } while (&getnextbug);
490 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
492 $ref= $1; $newpackage= $2;
493 $bug_affected{$ref}=1;
495 $newpackage =~ y/A-Z/a-z/;
497 if (length($data->{package})) {
498 $action= "$gBug reassigned from package \`$data->{package}'".
499 " to \`$newpackage'.";
501 $action= "$gBug assigned to package \`$newpackage'.";
504 &addmaintainers($data);
505 $data->{package}= $newpackage;
506 $data->{found_versions}= [];
507 $data->{fixed_versions}= [];
508 # TODO: what if $newpackage is a source package?
509 addfoundversions($data, $data->{package}, $version, 'binary');
510 &addmaintainers($data);
511 } while (&getnextbug);
513 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
514 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
515 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
516 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
519 $bug_affected{$ref}=1;
521 if (@{$data->{fixed_versions}}) {
522 &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");
524 if (!length($data->{done})) {
525 &transcript("$gBug is already open, cannot reopen.\n\n");
529 $noriginator eq '' ? "$gBug reopened, originator not changed." :
530 "$gBug reopened, originator set to $noriginator.";
532 &addmaintainers($data);
533 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
534 $data->{fixed_versions}= [];
536 } while (&getnextbug);
539 } elsif (m{^found\s+\#?(-?\d+)
540 (?:\s+((?:$config{package_name_re}\/)?
541 $config{package_version_re}))?$}ix) {
546 if (!length($data->{done}) and not defined($version)) {
547 &transcript("$gBug is already open, cannot reopen.\n\n");
553 "$gBug marked as found in version $version." :
556 &addmaintainers($data);
557 # The 'done' field gets a bit weird with version
558 # tracking, because a bug may be closed by multiple
559 # people in different branches. Until we have something
560 # more flexible, we set it every time a bug is fixed,
561 # and clear it when a bug is found in a version greater
562 # than any version in which the bug is fixed or when
563 # a bug is found and there is no fixed version
564 if (defined $version) {
565 my ($version_only) = $version =~ m{([^/]+)$};
566 addfoundversions($data, $data->{package}, $version, 'binary');
567 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
568 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
569 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
570 $action = "$gBug marked as found in version $version and reopened."
571 if length $data->{done};
575 # Versionless found; assume old-style "not fixed at
577 $data->{fixed_versions} = [];
580 } while (&getnextbug);
583 } elsif (m[^notfound\s+\#?(-?\d+)\s+
584 ((?:$config{package_name_re}\/)?
590 $action= "$gBug no longer marked as found in version $version.";
591 if (length($data->{done})) {
592 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
595 &addmaintainers($data);
596 removefoundversions($data, $data->{package}, $version, 'binary');
597 } while (&getnextbug);
600 elsif (m[^fixed\s+\#?(-?\d+)\s+
601 ((?:$config{package_name_re}\/)?
602 $config{package_version_re})\s*$]ix) {
609 "$gBug marked as fixed in version $version." :
612 &addmaintainers($data);
613 addfixedversions($data, $data->{package}, $version, 'binary');
614 } while (&getnextbug);
617 elsif (m[^notfixed\s+\#?(-?\d+)\s+
618 ((?:$config{package_name_re}\/)?
626 "$gBug no longer marked as fixed in version $version." :
629 &addmaintainers($data);
630 removefixedversions($data, $data->{package}, $version, 'binary');
631 } while (&getnextbug);
634 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
635 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
638 $bug_affected{$ref}=1;
639 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
640 $ref = $clonebugs{$ref};
642 if (not Mail::RFC822::Address::valid($newsubmitter)) {
643 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
647 if (&checkpkglimit) {
649 &addmaintainers($data);
650 $oldsubmitter= $data->{originator};
651 $data->{originator}= $newsubmitter;
652 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
654 &transcript("$action\n");
655 if (length($data->{done})) {
656 &transcript("(By the way, that $gBug is currently marked as done.)\n");
660 From: $gMaintainerEmail ($gProject $gBug Tracking System)
662 Subject: $gBug#$ref submitter address changed
664 References: $header{'message-id'} $data->{msgid}
665 In-Reply-To: $data->{msgid}
666 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
667 Reply-To: $ref\@$gEmailDomain
668 X-$gProject-PR-Message: submitter-changed $ref
670 The submitter address recorded for your $gBug report
671 #$ref: $data->{subject}
674 The old submitter address for this report was
676 The new submitter address is
679 This change was made by
681 If it was incorrect, please contact them directly.
684 (administrator, $gProject $gBugs database)
687 &sendmailmessage($message,$oldsubmitter);
694 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
696 $ref= $1; $whereto= $2;
697 $bug_affected{$ref}=1;
699 if (length($data->{forwarded})) {
700 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
702 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
704 if (length($data->{done})) {
705 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
708 &addmaintainers($data);
709 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
710 &addccaddress("$gForwardList\@$gListDomain");
712 $data->{forwarded}= $whereto;
713 } while (&getnextbug);
715 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
718 $bug_affected{$ref}=1;
720 if (!length($data->{forwarded})) {
721 &transcript("$gBug is not marked as having been forwarded.\n\n");
724 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
726 &addmaintainers($data);
727 $data->{forwarded}= '';
728 } while (&getnextbug);
731 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
732 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
735 $bug_affected{$ref}=1;
737 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
738 &transcript("Severity level \`$newseverity' is not known.\n".
739 "Recognized are: $gShowSeverities.\n\n");
741 } elsif (exists $gObsoleteSeverities{$newseverity}) {
742 &transcript("Severity level \`$newseverity' is obsolete. " .
743 "Use $gObsoleteSeverities{$newseverity} instead.\n\n");
746 $printseverity= $data->{severity};
747 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
748 $action= "Severity set to \`$newseverity' from \`$printseverity'";
750 &addmaintainers($data);
751 if (defined $gStrongList and isstrongseverity($newseverity)) {
752 addbcc("$gStrongList\@$gListDomain");
754 $data->{severity}= $newseverity;
755 } while (&getnextbug);
757 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
759 $ref = $1; $addsubcode = $3; $tags = $4;
760 $bug_affected{$ref}=1;
762 if (defined $addsubcode) {
763 $addsub = "sub" if ($addsubcode eq "-");
764 $addsub = "add" if ($addsubcode eq "+");
765 $addsub = "set" if ($addsubcode eq "=");
769 foreach my $t (split /[\s,]+/, $tags) {
770 if (!grep($_ eq $t, @gTags)) {
777 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
778 "Recognized are: ".join(' ', @gTags).".\n\n");
782 if ($data->{keywords} eq '') {
783 &transcript("There were no tags set.\n");
785 &transcript("Tags were: $data->{keywords}\n");
787 if ($addsub eq "set") {
788 $action= "Tags set to: " . join(", ", @okaytags);
789 } elsif ($addsub eq "add") {
790 $action= "Tags added: " . join(", ", @okaytags);
791 } elsif ($addsub eq "sub") {
792 $action= "Tags removed: " . join(", ", @okaytags);
795 &addmaintainers($data);
796 $data->{keywords} = '' if ($addsub eq "set");
797 # Allow removing obsolete tags.
798 if ($addsub eq "sub") {
799 foreach my $t (@badtags) {
800 $data->{keywords} = join ' ', grep $_ ne $t,
801 split ' ', $data->{keywords};
804 # Now process all other additions and subtractions.
805 foreach my $t (@okaytags) {
806 $data->{keywords} = join ' ', grep $_ ne $t,
807 split ' ', $data->{keywords};
808 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
810 $data->{keywords} =~ s/\s*$//;
811 } while (&getnextbug);
813 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
815 my $bugnum = $2; my $blockers = $4;
817 $addsub = "sub" if ($1 eq "un");
818 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
819 $bugnum = $clonebugs{$bugnum};
824 foreach my $b (split /[\s,]+/, $blockers) {
828 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
829 $ref = $clonebugs{$ref};
833 push @okayblockers, $ref;
835 # add to the list all bugs that are merged with $b,
836 # because all of their data must be kept in sync
837 @thisbugmergelist= split(/ /,$data->{mergedwith});
840 foreach $ref (@thisbugmergelist) {
842 push @okayblockers, $ref;
849 push @badblockers, $ref;
853 push @badblockers, $b;
857 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
863 if ($data->{blockedby} eq '') {
864 &transcript("Was not blocked by any bugs.\n");
866 &transcript("Was blocked by: $data->{blockedby}\n");
868 if ($addsub eq "set") {
869 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
870 } elsif ($addsub eq "add") {
871 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
872 } elsif ($addsub eq "sub") {
873 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
878 &addmaintainers($data);
879 my @oldblockerlist = split ' ', $data->{blockedby};
880 $data->{blockedby} = '' if ($addsub eq "set");
881 foreach my $b (@okayblockers) {
882 $data->{blockedby} = manipset($data->{blockedby}, $b,
886 foreach my $b (@oldblockerlist) {
887 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
888 push @{$removedblocks{$b}}, $ref;
891 foreach my $b (split ' ', $data->{blockedby}) {
892 if (! grep { $_ eq $b } @oldblockerlist) {
893 push @{$addedblocks{$b}}, $ref;
896 } while (&getnextbug);
898 # Now that the blockedby data is updated, change blocks data
899 # to match the changes.
900 foreach $ref (keys %addedblocks) {
902 foreach my $b (@{$addedblocks{$ref}}) {
903 $data->{blocks} = manipset($data->{blocks}, $b, 1);
908 foreach $ref (keys %removedblocks) {
910 foreach my $b (@{$removedblocks{$ref}}) {
911 $data->{blocks} = manipset($data->{blocks}, $b, 0);
917 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
919 $ref= $1; $newtitle= $2;
920 $bug_affected{$ref}=1;
921 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
922 $ref = $clonebugs{$ref};
925 if (&checkpkglimit) {
927 &addmaintainers($data);
928 my $oldtitle = $data->{subject};
929 $data->{subject}= $newtitle;
930 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
932 &transcript("$action\n");
933 if (length($data->{done})) {
934 &transcript("(By the way, that $gBug is currently marked as done.)\n");
943 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
946 $bug_affected{$ref} = 1;
948 if (!length($data->{mergedwith})) {
949 &transcript("$gBug is not marked as being merged with any others.\n\n");
952 $mergelowstate eq 'locked' || die "$mergelowstate ?";
953 $action= "Disconnected #$ref from all other report(s).";
954 @newmergelist= split(/ /,$data->{mergedwith});
956 @bug_affected{@newmergelist} = 1 x @newmergelist;
958 &addmaintainers($data);
959 $data->{mergedwith}= ($ref == $discref) ? ''
960 : join(' ',grep($_ ne $ref,@newmergelist));
961 } while (&getnextbug);
964 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
966 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
967 my @newmergelist= ();
972 while (defined($ref= shift(@tomerge))) {
973 &transcript("D| checking merge $ref\n") if $dl;
975 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
976 $ref = $clonebugs{$ref};
978 next if grep($_ == $ref,@newmergelist);
979 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
980 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
982 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
984 &checkmatch('package','m_package',$data->{package},@newmergelist);
985 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
986 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
987 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
988 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
989 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
990 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
991 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
992 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
993 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
994 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
995 if (length($mismatch)) {
996 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
999 &cancelbug; @newmergelist=(); last;
1001 push(@newmergelist,$ref);
1002 push(@tomerge,split(/ /,$data->{mergedwith}));
1005 if (@newmergelist) {
1006 @newmergelist= sort { $a <=> $b } @newmergelist;
1007 $action= "Merged @newmergelist.";
1008 delete @fixed{keys %found};
1009 for $ref (@newmergelist) {
1010 &getbug || die "huh ? $gBug $ref disappeared during merge";
1011 &addmaintainers($data);
1012 @bug_affected{@newmergelist} = 1 x @newmergelist;
1013 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1014 $data->{keywords}= join(' ', keys %tags);
1015 $data->{found_versions}= [sort keys %found];
1016 $data->{fixed_versions}= [sort keys %fixed];
1019 &transcript("$action\n\n");
1022 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
1024 my @temp = split /\s+\#?/,$1;
1025 my $master_bug = shift @temp;
1026 my $master_bug_data;
1027 my @tomerge = sort { $a <=> $b } @temp;
1028 unshift @tomerge,$master_bug;
1029 &transcript("D| force merging ".join(',',@tomerge)."\n") if $dl;
1030 my @newmergelist= ();
1034 # Here we try to do the right thing.
1035 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1036 # If not, we discard the found and fixed.
1037 # Everything else we set to the values of the first bug.
1039 while (defined($ref= shift(@tomerge))) {
1040 &transcript("D| checking merge $ref\n") if $dl;
1042 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1043 $ref = $clonebugs{$ref};
1045 next if grep($_ == $ref,@newmergelist);
1046 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1047 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1049 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
1050 $master_bug_data = $data if not defined $master_bug_data;
1051 if ($data->{package} ne $master_bug_data->{package}) {
1052 &transcript("Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1053 "$gBug $ref is not in the same package as $master_bug\n");
1055 &cancelbug; @newmergelist=(); last;
1057 for my $t (split /\s+/,$data->{keywords}) {
1060 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1061 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1062 push(@newmergelist,$ref);
1063 push(@tomerge,split(/ /,$data->{mergedwith}));
1066 if (@newmergelist) {
1067 @newmergelist= sort { $a <=> $b } @newmergelist;
1068 $action= "Forcibly Merged @newmergelist.";
1069 delete @fixed{keys %found};
1070 for $ref (@newmergelist) {
1071 &getbug || die "huh ? $gBug $ref disappeared during merge";
1072 &addmaintainers($data);
1073 @bug_affected{@newmergelist} = 1 x @newmergelist;
1074 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1075 $data->{keywords}= join(' ', keys %tags);
1076 $data->{found_versions}= [sort keys %found];
1077 $data->{fixed_versions}= [sort keys %fixed];
1078 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1079 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1082 &transcript("$action\n\n");
1085 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1089 @newclonedids = split /\s+/, $2;
1090 $newbugsneeded = scalar(@newclonedids);
1093 $bug_affected{$ref} = 1;
1095 if (length($data->{mergedwith})) {
1096 &transcript("$gBug is marked as being merged with others. Use an existing clone.\n\n");
1100 &filelock("nextnumber.lock");
1101 open(N,"nextnumber") || &quit("nextnumber: read: $!");
1102 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
1103 $firstref= $v+0; $v += $newbugsneeded;
1104 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1107 $lastref = $firstref + $newbugsneeded - 1;
1109 if ($newbugsneeded == 1) {
1110 $action= "$gBug $origref cloned as bug $firstref.";
1112 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1115 my $blocks = $data->{blocks};
1116 my $blockedby = $data->{blockedby};
1119 my $ohash = get_hashname($origref);
1120 my $clone = $firstref;
1121 @bug_affected{@newclonedids} = 1 x @newclonedids;
1122 for $newclonedid (@newclonedids) {
1123 $clonebugs{$newclonedid} = $clone;
1125 my $hash = get_hashname($clone);
1126 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1127 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1128 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1129 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1130 &bughook('new', $clone, $data);
1132 # Update blocking info of bugs blocked by or blocking the
1134 foreach $ref (split ' ', $blocks) {
1136 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1139 foreach $ref (split ' ', $blockedby) {
1141 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1149 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1151 my @pkgs = split /\s+/, $1;
1152 if (scalar(@pkgs) > 0) {
1153 %limit_pkgs = map { ($_, 1) } @pkgs;
1154 &transcript("Ignoring bugs not assigned to: " .
1155 join(" ", keys(%limit_pkgs)) . "\n\n");
1158 &transcript("Not ignoring any bugs.\n\n");
1160 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1161 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1164 $bug_affected{$ref} = 1;
1166 if (length $data->{owner}) {
1167 $action = "Owner changed from $data->{owner} to $newowner.";
1169 $action = "Owner recorded as $newowner.";
1171 if (length $data->{done}) {
1172 $extramessage = "(By the way, this $gBug is currently " .
1173 "marked as done.)\n";
1176 &addmaintainers($data);
1177 $data->{owner} = $newowner;
1178 } while (&getnextbug);
1180 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1183 $bug_affected{$ref} = 1;
1185 if (length $data->{owner}) {
1186 $action = "Removed annotation that $gBug was owned by " .
1189 &addmaintainers($data);
1190 $data->{owner} = '';
1191 } while (&getnextbug);
1193 &transcript("$gBug is not marked as having an owner.\n\n");
1197 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1200 $bug_affected{$ref} = 1;
1203 bug_unarchive(bug => $ref,
1204 transcript => \$transcript,
1205 affected_bugs => \%bug_affected,
1206 requester => $header{from},
1207 request_addr => $controlrequestaddr,
1214 transcript($transcript."\n");
1215 } elsif (m/^archive\s+#?(\d+)$/i) {
1218 $bug_affected{$ref} = 1;
1220 if (exists $data->{unarchived}) {
1224 bug_archive(bug => $ref,
1225 transcript => \$transcript,
1227 affected_bugs => \%bug_affected,
1228 requester => $header{from},
1229 request_addr => $controlrequestaddr,
1236 transcript($transcript."\n");
1239 transcript("$gBug $ref has not been archived previously\n\n");
1245 &transcript("Unknown command or malformed arguments to command.\n\n");
1247 if (++$unknowns >= 5) {
1248 &transcript("Too many unknown commands, stopping here.\n\n");
1253 if ($procline>$#bodylines) {
1254 &transcript(">\nEnd of message, stopping processing here.\n\n");
1256 if (!$ok && !quickabort) {
1258 &transcript("No commands successfully parsed; sending the help text(s).\n");
1263 &transcript("MC\n") if $dl>1;
1265 for $maint (keys %maintccreasons) {
1266 &transcript("MM|$maint|\n") if $dl>1;
1267 next if $maint eq $replyto;
1269 $reasonsref= $maintccreasons{$maint};
1270 &transcript("MY|$maint|\n") if $dl>2;
1271 for $p (sort keys %$reasonsref) {
1272 &transcript("MP|$p|\n") if $dl>2;
1273 $reasonstring.= ', ' if length($reasonstring);
1274 $reasonstring.= $p.' ' if length($p);
1275 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1277 if (length($reasonstring) > 40) {
1278 (substr $reasonstring, 37) = "...";
1280 $reasonstring = "" if (!defined($reasonstring));
1281 push(@maintccs,"$maint ($reasonstring)");
1282 push(@maintccaddrs,"$maint");
1287 &transcript("MC|@maintccs|\n") if $dl>2;
1288 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1292 for my $maint (keys %maintccreasons) {
1293 for my $package (keys %{$maintccreasons{$maint}}) {
1294 next unless length $package;
1295 $packagepr{$package} = 1;
1299 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1301 # Add Bcc's to subscribed bugs
1302 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1304 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1305 $header{'subject'} = "your mail";
1308 # Error text here advertises how many errors there were
1309 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1312 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1314 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1315 In-Reply-To: $header{'message-id'}
1316 References: $header{'message-id'}
1317 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1319 ${packagepr}X-$gProject-PR-Message: transcript
1321 ${transcript}Please contact me if you need assistance.
1324 (administrator, $gProject $gBugs database)
1328 $repliedshow= join(', ',$replyto,@maintccaddrs);
1329 # -1 is the service.in log
1330 &filelock("lock/-1");
1331 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1333 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1335 "<strong>Request received</strong> from <code>".
1336 html_escape($header{'from'})."</code>\n".
1337 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1339 "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/-1.log: $!");
1340 close(AP) || &quit("open db-h/-1.log: $!");
1342 utime(time,time,"db-h");
1344 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1346 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1348 sub sendmailmessage {
1349 local ($message,@recips) = @_;
1350 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1351 send_mail_message(message => $message,
1352 recipients => \@recips,
1358 my ($template,$extra_var) = @_;
1360 my $variables = {config => \%config,
1361 defined($ref)?(ref => $ref):(),
1362 defined($data)?(data => $data):(),
1365 my $hole_var = {'&bugurl' =>
1367 'http://'.$config{cgi_domain}.'/'.
1368 Debbugs::CGI::bug_url($_[0]);
1371 return fill_in_template(template => $template,
1372 variables => $variables,
1373 hole_var => $hole_var,
1377 =head2 message_body_template
1379 message_body_template('mail/ack',{ref=>'foo'});
1381 Creates a message body using a template
1385 sub message_body_template{
1386 my ($template,$extra_var) = @_;
1388 my $body = fill_template($template,$extra_var);
1389 return fill_template('mail/message_body',
1397 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1398 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1402 #sub unimplemented {
1403 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1407 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1409 if (@newmergelist) {
1410 eval "\$mvarvalue= \$$mvarname";
1411 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1414 "Values for \`$string' don't match:\n".
1415 " #$newmergelist[0] has \`$mvarvalue';\n".
1416 " #$ref has \`$svarvalue'\n"
1417 if $mvarvalue ne $svarvalue;
1419 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1421 eval "\$$mvarname= \$svarvalue";
1426 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1427 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1439 my %h = map { $_ => 1 } split ' ', $list;
1446 return join ' ', sort keys %h;
1449 # High-level bug manipulation calls
1450 # Do announcements themselves
1452 # Possible calling sequences:
1453 # setbug (returns 0)
1455 # setbug (returns 1)
1456 # &transcript(something)
1459 # setbug (returns 1)
1460 # $action= (something)
1462 # (modify s_* variables)
1463 # } while (getnextbug);
1466 &dlen("nochangebug");
1467 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1469 &endmerge if $manybugs;
1471 &dlex("nochangebug");
1475 &dlen("setbug $ref");
1476 if ($ref =~ m/^-\d+/) {
1477 if (!defined $clonebugs{$ref}) {
1479 &dlex("setbug => noclone");
1482 $ref = $clonebugs{$ref};
1484 $state eq 'idle' || die "$state ?";
1487 &dlex("setbug => 0s");
1491 if (!&checkpkglimit) {
1496 @thisbugmergelist= split(/ /,$data->{mergedwith});
1497 if (!@thisbugmergelist) {
1502 &dlex("setbug => 1s");
1511 &dlex("setbug => 0mc");
1515 $state= 'multiple'; $sref=$ref;
1516 &dlex("setbug => 1m");
1521 &dlen("getnextbug");
1522 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1524 if (!$manybugs || !@thisbugmergelist) {
1525 length($action) || die;
1526 &transcript("$action\n$extramessage\n");
1527 &endmerge if $manybugs;
1529 &dlex("getnextbug => 0");
1532 $ref= shift(@thisbugmergelist);
1533 &getbug || die "bug $ref disappeared";
1535 &dlex("getnextbug => 1");
1539 # Low-level bug-manipulation calls
1540 # Do no announcements
1542 # getbug (returns 0)
1544 # getbug (returns 1)
1548 # $action= (something)
1549 # getbug (returns 1)
1551 # getbug (returns 1)
1553 # [getbug (returns 0)]
1554 # &transcript("$action\n\n")
1557 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1558 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1562 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1563 &filelock('lock/merge');
1564 $mergelowstate='locked';
1570 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1572 $mergelowstate='idle';
1577 &dlen("getbug $ref");
1578 $lowstate eq 'idle' || die "$state ?";
1579 # Only use unmerged bugs here
1580 if (($data = &lockreadbug($ref,'db-h'))) {
1583 &dlex("getbug => 1");
1588 &dlex("getbug => 0");
1594 $lowstate eq 'open' || die "$state ?";
1601 &dlen("savebug $ref");
1602 $lowstate eq 'open' || die "$lowstate ?";
1603 length($action) || die;
1604 $ref == $sref || die "read $sref but saving $ref ?";
1605 append_action_to_log(bug => $ref,
1607 requester => $header{from},
1608 request_addr => $controlrequestaddr,
1612 unlockwritebug($ref, $data);
1619 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1624 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1628 print $_[0] if $debug;
1629 $transcript.= $_[0];
1636 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1637 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1653 sub sendtxthelpraw {
1654 local ($relpath,$description) = @_;
1656 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1657 while(<D>) { $doc.=$_; }
1659 &transcript("Sending $description in separate message.\n");
1660 &sendmailmessage(<<END.$doc,$replyto);
1661 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1663 Subject: $gProject $gBug help: $description
1664 References: $header{'message-id'}
1665 In-Reply-To: $header{'message-id'}
1666 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1668 X-$gProject-PR-Message: doc-text $relpath
1674 sub sendlynxdocraw {
1675 local ($relpath,$description) = @_;
1677 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1678 while(<L>) { $doc.=$_; }
1680 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1681 &transcript("Information ($description) is not available -\n".
1682 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1685 &transcript("Error getting $description (code $? $!):\n$doc\n");
1687 &transcript("Sending $description.\n");
1688 &sendmailmessage(<<END.$doc,$replyto);
1689 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1691 Subject: $gProject $gBugs information: $description
1692 References: $header{'message-id'}
1693 In-Reply-To: $header{'message-id'}
1694 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1696 X-$gProject-PR-Message: doc-html $relpath
1705 $maintccreasons{$cca}{''}{$ref}= 1;
1708 sub addmaintainers {
1709 # Data structure is:
1710 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1713 &ensuremaintainersloaded;
1714 $anymaintfound=0; $anymaintnotfound=0;
1715 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1717 $p =~ /([a-z0-9.+-]+)/;
1719 next unless defined $p;
1720 if (defined $gSubscriptionDomain) {
1721 if (defined($pkgsrc{$p})) {
1722 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1724 addbcc("$p\@$gSubscriptionDomain");
1727 if (defined $data->{severity} and defined $gStrongList and
1728 isstrongseverity($data->{severity})) {
1729 addbcc("$gStrongList\@$gListDomain");
1731 if (defined($maintainerof{$p})) {
1732 $addmaint= $maintainerof{$p};
1733 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1734 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1735 print "maintainer add >$p|$addmaint<\n" if $debug;
1737 print "maintainer none >$p<\n" if $debug;
1738 &transcript("Warning: Unknown package '$p'\n");
1739 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1740 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1744 if (length $data->{owner}) {
1745 $addmaint = $data->{owner};
1746 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1747 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1748 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1752 sub ensuremaintainersloaded {
1754 return if $maintainersloaded++;
1755 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1759 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1760 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1761 $maintainerof{$a}= $2;
1764 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1768 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1769 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1770 $maintainerof{$a}= $2;
1773 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1775 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1776 my ($a, $b) = ($1, $2);
1777 $pkgsrc{lc($a)} = $b;
1783 local ($wherefrom,$path,$description) = @_;
1784 if ($wherefrom eq "ftp.d.o") {
1785 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1787 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1788 &transcript("$description is not available.\n");
1791 &transcript("Error getting $description (code $? $!):\n$doc\n");
1794 } elsif ($wherefrom eq "local") {
1796 $doc = do { local $/; <P> };
1799 &transcript("internal errror: info files location unknown.\n");
1802 &transcript("Sending $description.\n");
1803 &sendmailmessage(<<END.$doc,$replyto);
1804 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1806 Subject: $gProject $gBugs information: $description
1807 References: $header{'message-id'}
1808 In-Reply-To: $header{'message-id'}
1809 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1811 X-$gProject-PR-Message: getinfo
1813 $description follows: