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 @headerlines = @{$entity->head->header};
67 my $entity_body = getmailbody($entity);
68 @bodylines = $entity_body ? $entity_body->as_lines() : ();
71 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
73 for ($i = 0; $i <= $#msg; $i++) {
75 last unless length($_);
76 while ($msg[$i+1] =~ m/^\s/) {
80 push @headerlines, $_;
83 @bodylines = @msg[$i..$#msg];
87 $_ = decode_rfc1522($_);
89 print ">$_<\n" if $debug;
92 print ">$v=$_<\n" if $debug;
95 print "!>$_<\n" if $debug;
99 # Strip off RFC2440-style PGP clearsigning.
100 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
101 shift @bodylines while @bodylines and length $bodylines[0];
102 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
103 for my $findsig (0 .. $#bodylines) {
104 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
105 $#bodylines = $findsig - 1;
109 map { s/^- // } @bodylines;
112 grep(s/\s+$//,@bodylines);
114 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
116 if (defined $header{'resent-from'} && !defined $header{'from'}) {
117 $header{'from'} = $header{'resent-from'};
120 defined($header{'from'}) || &quit("no From header");
122 delete $header{'reply-to'}
123 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
125 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
126 $replyto = $header{'reply-to'};
128 $replyto = $header{'from'};
131 # This is an error counter which should be incremented every time there is an error.
133 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
135 &transcript("Processing commands for $controlrequestaddr:\n\n");
140 $mergelowstate= 'idle';
146 $user =~ s/^.*<(.*)>.*$/$1/;
147 $user =~ s/[(].*[)]//;
148 $user =~ s/^\s*(\S+)\s+.*$/$1/;
149 $user = "" unless (Debbugs::User::is_valid_user($user));
150 my $indicated_user = 0;
154 my $fuckheads = "(" . join("|", @gExcludeFromControl) . ")";
155 if (@gExcludeFromControl and $replyto =~ m/$fuckheads/) {
156 &transcript(fill_template('mail/excluded_from_control'));
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 my ($template,$extra_var) = @_;
1359 my $variables = {config => \%config,
1360 defined($ref)?(ref => $ref):(),
1361 defined($data)?(data => $data):(),
1364 my $hole_var = {'&bugurl' =>
1366 'http://'.$config{cgi_domain}.'/'.
1367 Debbugs::CGI::bug_url($_[0]);
1370 return fill_in_template(template => $template,
1371 variables => $variables,
1372 hole_var => $hole_var,
1376 =head2 message_body_template
1378 message_body_template('mail/ack',{ref=>'foo'});
1380 Creates a message body using a template
1384 sub message_body_template{
1385 my ($template,$extra_var) = @_;
1387 my $body = fill_template($template,$extra_var);
1388 return fill_template('mail/message_body',
1396 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1397 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1401 #sub unimplemented {
1402 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1406 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1408 if (@newmergelist) {
1409 eval "\$mvarvalue= \$$mvarname";
1410 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1413 "Values for \`$string' don't match:\n".
1414 " #$newmergelist[0] has \`$mvarvalue';\n".
1415 " #$ref has \`$svarvalue'\n"
1416 if $mvarvalue ne $svarvalue;
1418 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1420 eval "\$$mvarname= \$svarvalue";
1425 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1426 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1438 my %h = map { $_ => 1 } split ' ', $list;
1445 return join ' ', sort keys %h;
1448 # High-level bug manipulation calls
1449 # Do announcements themselves
1451 # Possible calling sequences:
1452 # setbug (returns 0)
1454 # setbug (returns 1)
1455 # &transcript(something)
1458 # setbug (returns 1)
1459 # $action= (something)
1461 # (modify s_* variables)
1462 # } while (getnextbug);
1465 &dlen("nochangebug");
1466 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1468 &endmerge if $manybugs;
1470 &dlex("nochangebug");
1474 &dlen("setbug $ref");
1475 if ($ref =~ m/^-\d+/) {
1476 if (!defined $clonebugs{$ref}) {
1478 &dlex("setbug => noclone");
1481 $ref = $clonebugs{$ref};
1483 $state eq 'idle' || die "$state ?";
1486 &dlex("setbug => 0s");
1490 if (!&checkpkglimit) {
1495 @thisbugmergelist= split(/ /,$data->{mergedwith});
1496 if (!@thisbugmergelist) {
1501 &dlex("setbug => 1s");
1510 &dlex("setbug => 0mc");
1514 $state= 'multiple'; $sref=$ref;
1515 &dlex("setbug => 1m");
1520 &dlen("getnextbug");
1521 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1523 if (!$manybugs || !@thisbugmergelist) {
1524 length($action) || die;
1525 &transcript("$action\n$extramessage\n");
1526 &endmerge if $manybugs;
1528 &dlex("getnextbug => 0");
1531 $ref= shift(@thisbugmergelist);
1532 &getbug || die "bug $ref disappeared";
1534 &dlex("getnextbug => 1");
1538 # Low-level bug-manipulation calls
1539 # Do no announcements
1541 # getbug (returns 0)
1543 # getbug (returns 1)
1547 # $action= (something)
1548 # getbug (returns 1)
1550 # getbug (returns 1)
1552 # [getbug (returns 0)]
1553 # &transcript("$action\n\n")
1556 sub notfoundbug { &transcript("$gBug number $ref not found. (Is it archived?)\n\n"); }
1557 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1561 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1562 &filelock('lock/merge');
1563 $mergelowstate='locked';
1569 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1571 $mergelowstate='idle';
1576 &dlen("getbug $ref");
1577 $lowstate eq 'idle' || die "$state ?";
1578 # Only use unmerged bugs here
1579 if (($data = &lockreadbug($ref,'db-h'))) {
1582 &dlex("getbug => 1");
1587 &dlex("getbug => 0");
1593 $lowstate eq 'open' || die "$state ?";
1600 &dlen("savebug $ref");
1601 $lowstate eq 'open' || die "$lowstate ?";
1602 length($action) || die;
1603 $ref == $sref || die "read $sref but saving $ref ?";
1604 append_action_to_log(bug => $ref,
1606 requester => $header{from},
1607 request_addr => $controlrequestaddr,
1611 unlockwritebug($ref, $data);
1618 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1623 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1627 print $_[0] if $debug;
1628 $transcript.= $_[0];
1635 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1636 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1652 sub sendtxthelpraw {
1653 local ($relpath,$description) = @_;
1655 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1656 while(<D>) { $doc.=$_; }
1658 &transcript("Sending $description in separate message.\n");
1659 &sendmailmessage(<<END.$doc,$replyto);
1660 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1662 Subject: $gProject $gBug help: $description
1663 References: $header{'message-id'}
1664 In-Reply-To: $header{'message-id'}
1665 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1667 X-$gProject-PR-Message: doc-text $relpath
1673 sub sendlynxdocraw {
1674 local ($relpath,$description) = @_;
1676 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1677 while(<L>) { $doc.=$_; }
1679 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1680 &transcript("Information ($description) is not available -\n".
1681 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1684 &transcript("Error getting $description (code $? $!):\n$doc\n");
1686 &transcript("Sending $description.\n");
1687 &sendmailmessage(<<END.$doc,$replyto);
1688 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1690 Subject: $gProject $gBugs information: $description
1691 References: $header{'message-id'}
1692 In-Reply-To: $header{'message-id'}
1693 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1695 X-$gProject-PR-Message: doc-html $relpath
1704 $maintccreasons{$cca}{''}{$ref}= 1;
1707 sub addmaintainers {
1708 # Data structure is:
1709 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1712 &ensuremaintainersloaded;
1713 $anymaintfound=0; $anymaintnotfound=0;
1714 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1716 $p =~ /([a-z0-9.+-]+)/;
1718 next unless defined $p;
1719 if (defined $gSubscriptionDomain) {
1720 if (defined($pkgsrc{$p})) {
1721 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1723 addbcc("$p\@$gSubscriptionDomain");
1726 if (defined $data->{severity} and defined $gStrongList and
1727 isstrongseverity($data->{severity})) {
1728 addbcc("$gStrongList\@$gListDomain");
1730 if (defined($maintainerof{$p})) {
1731 $addmaint= $maintainerof{$p};
1732 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1733 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1734 print "maintainer add >$p|$addmaint<\n" if $debug;
1736 print "maintainer none >$p<\n" if $debug;
1737 &transcript("Warning: Unknown package '$p'\n");
1738 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1739 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1743 if (length $data->{owner}) {
1744 $addmaint = $data->{owner};
1745 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1746 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1747 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1751 sub ensuremaintainersloaded {
1753 return if $maintainersloaded++;
1754 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1758 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1759 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1760 $maintainerof{$a}= $2;
1763 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1767 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1768 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1769 $maintainerof{$a}= $2;
1772 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1774 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1775 my ($a, $b) = ($1, $2);
1776 $pkgsrc{lc($a)} = $b;
1782 local ($wherefrom,$path,$description) = @_;
1783 if ($wherefrom eq "ftp.d.o") {
1784 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1786 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1787 &transcript("$description is not available.\n");
1790 &transcript("Error getting $description (code $? $!):\n$doc\n");
1793 } elsif ($wherefrom eq "local") {
1795 $doc = do { local $/; <P> };
1798 &transcript("internal errror: info files location unknown.\n");
1801 &transcript("Sending $description.\n");
1802 &sendmailmessage(<<END.$doc,$replyto);
1803 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1805 Subject: $gProject $gBugs information: $description
1806 References: $header{'message-id'}
1807 In-Reply-To: $header{'message-id'}
1808 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1810 X-$gProject-PR-Message: getinfo
1812 $description follows: