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
13 use Params::Validate qw(:types validate_with);
15 use Debbugs::Common qw(:util :quit :misc :lock)
17 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
18 use Debbugs::Mail qw(send_mail_message);
20 use HTML::Entities qw(encode_entities);
21 use Debbugs::Versions::Dpkg;
23 use Debbugs::Status qw(splitpackages);
25 use Debbugs::Config qw(:globals :config);
26 use Debbugs::CGI qw(html_escape);
27 use Debbugs::Control qw(:archive :log);
28 use Debbugs::Log qw(:misc);
29 use Debbugs::Text qw(:templates);
31 use Mail::RFC822::Address;
33 chdir($config{spoool_dir}) or
34 die "Unable to chdir to spool_dir '$config{spool_dir}': $!";
39 my ($control, $nn) = $ARGV[0] =~ m/^([RC])\.(\d+)$/ || die "bad argument";
40 if (!rename("incoming/G$nn","incoming/P$nn")) {
41 defined $! and $! =~ m/no such file or directory/i and exit 0;
42 die "Failed to rename incoming/G$nn to incoming/P$nn: $!";
45 my $log_fh = IO::File->new("incoming/P$nn",'r') or
46 die "Unable to open incoming/P$nn for reading: $!";
53 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
55 # Bug numbers to send e-mail to, hash so that we don't send to the
59 my (@headerlines,@bodylines);
61 my $parse_output = Debbugs::MIME::parse(join('',@log));
62 @headerlines = @{$parse_output->{header}};
63 @bodylines = @{$parse_output->{body}};
67 $_ = decode_rfc1522($_);
69 print ">$_<\n" if $debug;
72 print ">$v=$_<\n" if $debug;
75 print "!>$_<\n" if $debug;
79 grep(s/\s+$//,@bodylines);
81 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
83 if (defined $header{'resent-from'} && !defined $header{'from'}) {
84 $header{'from'} = $header{'resent-from'};
87 defined($header{'from'}) || die "no From header";
89 delete $header{'reply-to'}
90 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
93 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
94 $replyto = $header{'reply-to'};
96 $replyto = $header{'from'};
99 # This is an error counter which should be incremented every time there is an error.
101 my $controlrequestaddr= ($control ? 'control' : 'request').$config{email_domain};
102 my $transcript_scalar = '';
103 my $transcript = IO::Scalar->new(\$transcript_scalar) or
104 die "Unable to create new IO::Scalar";
105 print {$stranscript} "Processing commands for $controlrequestaddr:\n\n";
110 my $lowstate= 'idle';
111 my $mergelowstate= 'idle';
117 $user =~ s/^.*<(.*)>.*$/$1/;
118 $user =~ s/[(].*[)]//;
119 $user =~ s/^\s*(\S+)\s+.*$/$1/;
120 $user = "" unless (Debbugs::User::is_valid_user($user));
121 my $indicated_user = 0;
126 if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) {
127 print {$transcript} fill_template('mail/excluded_from_control');
136 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
139 for ($procline=0; $procline<=$#bodylines; $procline++) {
140 $state eq 'idle' || print "state: $state ?\n";
141 $lowstate eq 'idle' || print "lowstate: $lowstate ?\n";
142 $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n";
144 print {$transcript} "Stopping processing here.\n\n";
147 $_= $bodylines[$procline]; s/\s+$//;
149 print {$transcript} "> $_\n";
152 if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
153 print {$transcript} "Stopping processing here.\n\n";
155 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
157 print {$transcript} "Debug level $dl.\n\n";
158 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
160 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
161 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
163 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
164 "detailed logs for $gBug#$ref");
165 } elsif (m/^index(\s+full)?$/i) {
166 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
168 $ok++; # well, it's not really ok, but it fixes #81224 :)
169 } elsif (m/^index-summary\s+by-package$/i) {
170 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
172 $ok++; # well, it's not really ok, but it fixes #81224 :)
173 } elsif (m/^index-summary(\s+by-number)?$/i) {
174 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
176 $ok++; # well, it's not really ok, but it fixes #81224 :)
177 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
178 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
179 } elsif (m/^index(\s+|-)maints?$/i) {
180 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
181 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
183 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
184 "$gBug list for maintainer \`$maint'");
186 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
188 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
189 "$gBug list for package $package");
191 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
192 print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
194 $ok++; # well, it's not really ok, but it fixes #81224 :)
195 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
196 print {$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/^send-unmatched\s+(old|-2)$/i) {
200 print {$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/^getinfo\s+([\w-.]+)$/i) {
204 # the following is basically a Debian-specific kludge, but who cares
206 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
207 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
208 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
210 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
211 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
212 &sendinfo("local", "$gConfigDir/$req", "$req file");
214 print {$transcript} "Info file $req does not exist.\n\n";
216 } elsif (m/^help/i) {
218 print {$transcript} "\n";
220 } elsif (m/^refcard/i) {
221 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
222 } elsif (m/^subscribe/i) {
223 print {$transcript} <<END;
224 There is no $gProject $gBug mailing list. If you wish to review bug reports
225 please do so via http://$gWebDomain/ or ask this mail server
227 soon: MAILINGLISTS_TEXT
229 } elsif (m/^unsubscribe/i) {
230 print {$transcript} <<END;
231 soon: UNSUBSCRIBE_TEXT
232 soon: MAILINGLISTS_TEXT
234 } elsif (m/^user\s+(\S+)\s*$/i) {
236 if (Debbugs::User::is_valid_user($newuser)) {
237 my $olduser = ($user ne "" ? " (was $user)" : "");
238 print {$transcript} "Setting user to $newuser$olduser.\n";
242 print {$transcript} "Selected user id ($newuser) invalid, sorry\n";
247 } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
250 my $hidden = ($2 ne "");
257 print {$transcript} "No valid user selected\n";
261 if (not $indicated_user and defined $user) {
262 print {$transcript} "User is $user\n";
265 while (++$procline <= $#bodylines) {
266 unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
270 print {$transcript} "> $bodylines[$procline]\n";
272 my ($o, $txt) = ($1, $2);
273 if ($#cats == -1 && $o eq "+") {
274 print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n";
280 unless (ref($cats[-1]) eq "HASH") {
281 $cats[-1] = { "nam" => $cats[-1],
282 "pri" => [], "ttl" => [] };
285 my ($desc, $ord, $op);
286 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
287 $desc = $1; $ord = $3; $op = "";
288 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
289 $desc = $1; $ord = $3; $op = $4;
290 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
291 $desc = ""; $op = $1;
293 print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n";
298 $ord = 999 unless defined $ord;
301 push @{$cats[-1]->{"pri"}}, $prefix . $op;
302 push @{$cats[-1]->{"ttl"}}, $desc;
303 push @ords, "$ord $catsec";
305 @cats[-1]->{"def"} = $desc;
306 push @ords, "$ord DEF";
309 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
310 $a1 <=> $b1 || $a2 <=> $b2; } @ords;
311 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
312 } elsif ($o eq "*") {
315 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
316 $name = $1; $prefix = $3;
318 $name = $txt; $prefix = "";
323 # XXX: got @cats, now do something with it
324 my $u = Debbugs::User::get_user($user);
326 print {$transcript} "Added usercategory $catname.\n\n";
327 $u->{"categories"}->{$catname} = [ @cats ];
329 push @{$u->{visible_cats}},$catname;
332 print {$transcript} "Removed usercategory $catname.\n\n";
333 delete $u->{"categories"}->{$catname};
334 @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
337 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
339 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
340 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
341 $ref = $clonebugs{$ref};
344 print {$transcript} "No valid user selected\n";
348 if (not $indicated_user and defined $user) {
349 print {$transcript} "User is $user\n";
354 Debbugs::User::read_usertags(\%ut, $user);
355 my @oldtags = (); my @newtags = (); my @badtags = ();
357 for my $t (split /[,\s]+/, $tags) {
358 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
365 print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
368 for my $t (keys %chtags) {
369 $ut{$t} = [] unless defined $ut{$t};
371 for my $t (keys %ut) {
372 my %res = map { ($_, 1) } @{$ut{$t}};
373 push @oldtags, $t if defined $res{$ref};
374 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
375 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
376 : $addsubcode eq "=");
377 $res{$ref} = 1 if ($addop && defined $chtags{$t});
378 delete $res{$ref} if ($del);
379 push @newtags, $t if defined $res{$ref};
380 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
383 print {$transcript} "There were no usertags set.\n";
385 print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
387 print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
388 Debbugs::User::write_usertags(\%ut, $user);
390 } elsif (!$control) {
391 print {$transcript} <<END;
392 Unknown command or malformed arguments to command.
393 (Use control\@$gEmailDomain to manipulate reports.)
397 if (++$unknowns >= 3) {
398 print {$transcript} "Too many unknown commands, stopping here.\n\n";
401 #### "developer only" ones start here
402 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
405 $bug_affected{$ref}=1;
408 print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
409 if (length($data->{done}) and not defined($version)) {
410 print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
415 "marked as fixed in version $version" :
417 ", send any further explanations to $data->{originator}";
419 &addmaintainers($data);
420 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
421 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
422 $data->{done}= $replyto;
423 my @keywords= split ' ', $data->{keywords};
424 if (grep $_ eq 'pending', @keywords) {
425 $extramessage= "Removed pending tag.\n";
426 $data->{keywords}= join ' ', grep $_ ne 'pending',
429 addfixedversions($data, $data->{package}, $version, 'binary');
432 From: $gMaintainerEmail ($gProject $gBug Tracking System)
433 To: $data->{originator}
434 Subject: $gBug#$ref acknowledged by developer
436 References: $header{'message-id'} $data->{msgid}
437 In-Reply-To: $data->{msgid}
438 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
439 Reply-To: $ref\@$gEmailDomain
440 X-$gProject-PR-Message: they-closed-control $ref
442 This is an automatic notification regarding your $gBug report
443 #$ref: $data->{subject},
444 which was filed against the $data->{package} package.
446 It has been marked as closed by one of the developers, namely
449 You should be hearing from them with a substantive response shortly,
450 in case you haven't already. If not, please contact them directly.
453 (administrator, $gProject $gBugs database)
456 &sendmailmessage($message,$data->{originator});
457 } while (&getnextbug);
460 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
462 $ref= $1; $newpackage= $2;
463 $bug_affected{$ref}=1;
465 $newpackage =~ y/A-Z/a-z/;
467 if (length($data->{package})) {
468 $action= "$gBug reassigned from package \`$data->{package}'".
469 " to \`$newpackage'.";
471 $action= "$gBug assigned to package \`$newpackage'.";
474 &addmaintainers($data);
475 $data->{package}= $newpackage;
476 $data->{found_versions}= [];
477 $data->{fixed_versions}= [];
478 # TODO: what if $newpackage is a source package?
479 addfoundversions($data, $data->{package}, $version, 'binary');
480 &addmaintainers($data);
481 } while (&getnextbug);
483 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
484 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
485 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
486 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
489 $bug_affected{$ref}=1;
491 if (@{$data->{fixed_versions}}) {
492 print {$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";
494 if (!length($data->{done})) {
495 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
499 $noriginator eq '' ? "$gBug reopened, originator not changed." :
500 "$gBug reopened, originator set to $noriginator.";
502 &addmaintainers($data);
503 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
504 $data->{fixed_versions}= [];
506 } while (&getnextbug);
509 } elsif (m{^found\s+\#?(-?\d+)
510 (?:\s+((?:$config{package_name_re}\/)?
511 $config{package_version_re}))?$}ix) {
516 if (!length($data->{done}) and not defined($version)) {
517 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
523 "$gBug marked as found in version $version." :
526 &addmaintainers($data);
527 # The 'done' field gets a bit weird with version
528 # tracking, because a bug may be closed by multiple
529 # people in different branches. Until we have something
530 # more flexible, we set it every time a bug is fixed,
531 # and clear it when a bug is found in a version greater
532 # than any version in which the bug is fixed or when
533 # a bug is found and there is no fixed version
534 if (defined $version) {
535 my ($version_only) = $version =~ m{([^/]+)$};
536 addfoundversions($data, $data->{package}, $version, 'binary');
537 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
538 map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
539 if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
540 $action = "$gBug marked as found in version $version and reopened."
541 if length $data->{done};
545 # Versionless found; assume old-style "not fixed at
547 $data->{fixed_versions} = [];
550 } while (&getnextbug);
553 } elsif (m[^notfound\s+\#?(-?\d+)\s+
554 ((?:$config{package_name_re}\/)?
560 $action= "$gBug no longer marked as found in version $version.";
561 if (length($data->{done})) {
562 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
565 &addmaintainers($data);
566 removefoundversions($data, $data->{package}, $version, 'binary');
567 } while (&getnextbug);
570 elsif (m[^fixed\s+\#?(-?\d+)\s+
571 ((?:$config{package_name_re}\/)?
572 $config{package_version_re})\s*$]ix) {
579 "$gBug marked as fixed in version $version." :
582 &addmaintainers($data);
583 addfixedversions($data, $data->{package}, $version, 'binary');
584 } while (&getnextbug);
587 elsif (m[^notfixed\s+\#?(-?\d+)\s+
588 ((?:$config{package_name_re}\/)?
596 "$gBug no longer marked as fixed in version $version." :
599 &addmaintainers($data);
600 removefixedversions($data, $data->{package}, $version, 'binary');
601 } while (&getnextbug);
604 elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
605 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
608 $bug_affected{$ref}=1;
609 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
610 $ref = $clonebugs{$ref};
612 if (not Mail::RFC822::Address::valid($newsubmitter)) {
613 transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
617 if (&checkpkglimit) {
619 &addmaintainers($data);
620 $oldsubmitter= $data->{originator};
621 $data->{originator}= $newsubmitter;
622 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
624 print {$transcript} "$action\n";
625 if (length($data->{done})) {
626 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
628 print {$transcript} "\n";
630 From: $gMaintainerEmail ($gProject $gBug Tracking System)
632 Subject: $gBug#$ref submitter address changed
634 References: $header{'message-id'} $data->{msgid}
635 In-Reply-To: $data->{msgid}
636 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
637 Reply-To: $ref\@$gEmailDomain
638 X-$gProject-PR-Message: submitter-changed $ref
640 The submitter address recorded for your $gBug report
641 #$ref: $data->{subject}
644 The old submitter address for this report was
646 The new submitter address is
649 This change was made by
651 If it was incorrect, please contact them directly.
654 (administrator, $gProject $gBugs database)
657 &sendmailmessage($message,$oldsubmitter);
664 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
666 $ref= $1; $whereto= $2;
667 $bug_affected{$ref}=1;
669 if (length($data->{forwarded})) {
670 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
672 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
674 if (length($data->{done})) {
675 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
678 &addmaintainers($data);
679 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
680 &addccaddress("$gForwardList\@$gListDomain");
682 $data->{forwarded}= $whereto;
683 } while (&getnextbug);
685 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
688 $bug_affected{$ref}=1;
690 if (!length($data->{forwarded})) {
691 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
694 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
696 &addmaintainers($data);
697 $data->{forwarded}= '';
698 } while (&getnextbug);
701 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
702 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
705 $bug_affected{$ref}=1;
707 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
708 print {$transcript} "Severity level \`$newseverity' is not known.\n".
709 "Recognized are: $gShowSeverities.\n\n";
711 } elsif (exists $gObsoleteSeverities{$newseverity}) {
712 print {$transcript} "Severity level \`$newseverity' is obsolete. " .
713 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
716 $printseverity= $data->{severity};
717 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
718 $action= "Severity set to \`$newseverity' from \`$printseverity'";
720 &addmaintainers($data);
721 if (defined $gStrongList and isstrongseverity($newseverity)) {
722 addbcc("$gStrongList\@$gListDomain");
724 $data->{severity}= $newseverity;
725 } while (&getnextbug);
727 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
729 $ref = $1; $addsubcode = $3; $tags = $4;
730 $bug_affected{$ref}=1;
732 if (defined $addsubcode) {
733 $addsub = "sub" if ($addsubcode eq "-");
734 $addsub = "add" if ($addsubcode eq "+");
735 $addsub = "set" if ($addsubcode eq "=");
739 foreach my $t (split /[\s,]+/, $tags) {
740 if (!grep($_ eq $t, @gTags)) {
747 print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
748 "Recognized are: ".join(' ', @gTags).".\n\n";
752 if ($data->{keywords} eq '') {
753 print {$transcript} "There were no tags set.\n";
755 print {$transcript} "Tags were: $data->{keywords}\n";
757 if ($addsub eq "set") {
758 $action= "Tags set to: " . join(", ", @okaytags);
759 } elsif ($addsub eq "add") {
760 $action= "Tags added: " . join(", ", @okaytags);
761 } elsif ($addsub eq "sub") {
762 $action= "Tags removed: " . join(", ", @okaytags);
765 &addmaintainers($data);
766 $data->{keywords} = '' if ($addsub eq "set");
767 # Allow removing obsolete tags.
768 if ($addsub eq "sub") {
769 foreach my $t (@badtags) {
770 $data->{keywords} = join ' ', grep $_ ne $t,
771 split ' ', $data->{keywords};
774 # Now process all other additions and subtractions.
775 foreach my $t (@okaytags) {
776 $data->{keywords} = join ' ', grep $_ ne $t,
777 split ' ', $data->{keywords};
778 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
780 $data->{keywords} =~ s/\s*$//;
781 } while (&getnextbug);
783 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
785 my $bugnum = $2; my $blockers = $4;
787 $addsub = "sub" if ($1 eq "un");
788 if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
789 $bugnum = $clonebugs{$bugnum};
794 foreach my $b (split /[\s,]+/, $blockers) {
798 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
799 $ref = $clonebugs{$ref};
803 push @okayblockers, $ref;
805 # add to the list all bugs that are merged with $b,
806 # because all of their data must be kept in sync
807 @thisbugmergelist= split(/ /,$data->{mergedwith});
810 foreach $ref (@thisbugmergelist) {
812 push @okayblockers, $ref;
819 push @badblockers, $ref;
823 push @badblockers, $b;
827 print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
833 if ($data->{blockedby} eq '') {
834 print {$transcript} "Was not blocked by any bugs.\n";
836 print {$transcript} "Was blocked by: $data->{blockedby}\n";
838 if ($addsub eq "set") {
839 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
840 } elsif ($addsub eq "add") {
841 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
842 } elsif ($addsub eq "sub") {
843 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
848 &addmaintainers($data);
849 my @oldblockerlist = split ' ', $data->{blockedby};
850 $data->{blockedby} = '' if ($addsub eq "set");
851 foreach my $b (@okayblockers) {
852 $data->{blockedby} = manipset($data->{blockedby}, $b,
856 foreach my $b (@oldblockerlist) {
857 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
858 push @{$removedblocks{$b}}, $ref;
861 foreach my $b (split ' ', $data->{blockedby}) {
862 if (! grep { $_ eq $b } @oldblockerlist) {
863 push @{$addedblocks{$b}}, $ref;
866 } while (&getnextbug);
868 # Now that the blockedby data is updated, change blocks data
869 # to match the changes.
870 foreach $ref (keys %addedblocks) {
872 foreach my $b (@{$addedblocks{$ref}}) {
873 $data->{blocks} = manipset($data->{blocks}, $b, 1);
878 foreach $ref (keys %removedblocks) {
880 foreach my $b (@{$removedblocks{$ref}}) {
881 $data->{blocks} = manipset($data->{blocks}, $b, 0);
887 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
889 $ref= $1; $newtitle= $2;
890 $bug_affected{$ref}=1;
891 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
892 $ref = $clonebugs{$ref};
895 if (&checkpkglimit) {
897 &addmaintainers($data);
898 my $oldtitle = $data->{subject};
899 $data->{subject}= $newtitle;
900 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
902 print {$transcript} "$action\n";
903 if (length($data->{done})) {
904 print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
906 print {$transcript} "\n";
913 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
916 $bug_affected{$ref} = 1;
918 if (!length($data->{mergedwith})) {
919 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
922 $mergelowstate eq 'locked' || die "$mergelowstate ?";
923 $action= "Disconnected #$ref from all other report(s).";
924 @newmergelist= split(/ /,$data->{mergedwith});
926 @bug_affected{@newmergelist} = 1 x @newmergelist;
928 &addmaintainers($data);
929 $data->{mergedwith}= ($ref == $discref) ? ''
930 : join(' ',grep($_ ne $ref,@newmergelist));
931 } while (&getnextbug);
934 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
936 my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
937 my @newmergelist= ();
942 while (defined($ref= shift(@tomerge))) {
943 print {$transcript} "D| checking merge $ref\n" if $dl;
945 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
946 $ref = $clonebugs{$ref};
948 next if grep($_ == $ref,@newmergelist);
949 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
950 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
952 print {$transcript} "D| adding $ref ($data->{mergedwith})\n") if $dl;
954 &checkmatch('package','m_package',$data->{package},@newmergelist);
955 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
956 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
957 &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
958 &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
959 &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
960 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
961 &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
962 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
963 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
964 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
965 if (length($mismatch)) {
966 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
969 &cancelbug; @newmergelist=(); last;
971 push(@newmergelist,$ref);
972 push(@tomerge,split(/ /,$data->{mergedwith}));
976 @newmergelist= sort { $a <=> $b } @newmergelist;
977 $action= "Merged @newmergelist.";
978 delete @fixed{keys %found};
979 for $ref (@newmergelist) {
980 &getbug || die "huh ? $gBug $ref disappeared during merge";
981 &addmaintainers($data);
982 @bug_affected{@newmergelist} = 1 x @newmergelist;
983 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
984 $data->{keywords}= join(' ', keys %tags);
985 $data->{found_versions}= [sort keys %found];
986 $data->{fixed_versions}= [sort keys %fixed];
989 print {$transcript} "$action\n\n";
992 } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
994 my @temp = split /\s+\#?/,$1;
995 my $master_bug = shift @temp;
997 my @tomerge = sort { $a <=> $b } @temp;
998 unshift @tomerge,$master_bug;
999 print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1000 my @newmergelist= ();
1004 # Here we try to do the right thing.
1005 # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1006 # If not, we discard the found and fixed.
1007 # Everything else we set to the values of the first bug.
1009 while (defined($ref= shift(@tomerge))) {
1010 print {$transcript} "D| checking merge $ref\n" if $dl;
1012 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1013 $ref = $clonebugs{$ref};
1015 next if grep($_ == $ref,@newmergelist);
1016 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
1017 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1019 print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1020 $master_bug_data = $data if not defined $master_bug_data;
1021 if ($data->{package} ne $master_bug_data->{package}) {
1022 print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1023 "$gBug $ref is not in the same package as $master_bug\n";
1025 &cancelbug; @newmergelist=(); last;
1027 for my $t (split /\s+/,$data->{keywords}) {
1030 @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1031 @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1032 push(@newmergelist,$ref);
1033 push(@tomerge,split(/ /,$data->{mergedwith}));
1036 if (@newmergelist) {
1037 @newmergelist= sort { $a <=> $b } @newmergelist;
1038 $action= "Forcibly Merged @newmergelist.";
1039 delete @fixed{keys %found};
1040 for $ref (@newmergelist) {
1041 &getbug || die "huh ? $gBug $ref disappeared during merge";
1042 &addmaintainers($data);
1043 @bug_affected{@newmergelist} = 1 x @newmergelist;
1044 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1045 $data->{keywords}= join(' ', keys %tags);
1046 $data->{found_versions}= [sort keys %found];
1047 $data->{fixed_versions}= [sort keys %fixed];
1048 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1049 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1052 print {$transcript} "$action\n\n";
1055 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1059 @newclonedids = split /\s+/, $2;
1060 $newbugsneeded = scalar(@newclonedids);
1063 $bug_affected{$ref} = 1;
1065 if (length($data->{mergedwith})) {
1066 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1070 &filelock("nextnumber.lock");
1071 open(N,"nextnumber") || die "nextnumber: read: $!";
1072 $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1073 $firstref= $v+0; $v += $newbugsneeded;
1074 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1077 $lastref = $firstref + $newbugsneeded - 1;
1079 if ($newbugsneeded == 1) {
1080 $action= "$gBug $origref cloned as bug $firstref.";
1082 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1085 my $blocks = $data->{blocks};
1086 my $blockedby = $data->{blockedby};
1089 my $ohash = get_hashname($origref);
1090 my $clone = $firstref;
1091 @bug_affected{@newclonedids} = 1 x @newclonedids;
1092 for $newclonedid (@newclonedids) {
1093 $clonebugs{$newclonedid} = $clone;
1095 my $hash = get_hashname($clone);
1096 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1097 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1098 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1099 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1100 &bughook('new', $clone, $data);
1102 # Update blocking info of bugs blocked by or blocking the
1104 foreach $ref (split ' ', $blocks) {
1106 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1109 foreach $ref (split ' ', $blockedby) {
1111 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1119 } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1121 my @pkgs = split /\s+/, $1;
1122 if (scalar(@pkgs) > 0) {
1123 %limit_pkgs = map { ($_, 1) } @pkgs;
1124 print {$transcript} "Ignoring bugs not assigned to: " .
1125 join(" ", keys(%limit_pkgs)) . "\n\n";
1128 print {$transcript} "Not ignoring any bugs.\n\n";
1130 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1131 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1134 $bug_affected{$ref} = 1;
1136 if (length $data->{owner}) {
1137 $action = "Owner changed from $data->{owner} to $newowner.";
1139 $action = "Owner recorded as $newowner.";
1141 if (length $data->{done}) {
1142 $extramessage = "(By the way, this $gBug is currently " .
1143 "marked as done.)\n";
1146 &addmaintainers($data);
1147 $data->{owner} = $newowner;
1148 } while (&getnextbug);
1150 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1153 $bug_affected{$ref} = 1;
1155 if (length $data->{owner}) {
1156 $action = "Removed annotation that $gBug was owned by " .
1159 &addmaintainers($data);
1160 $data->{owner} = '';
1161 } while (&getnextbug);
1163 print {$transcript} "$gBug is not marked as having an owner.\n\n";
1167 } elsif (m/^unarchive\s+#?(\d+)$/i) {
1170 $bug_affected{$ref} = 1;
1172 bug_unarchive(bug => $ref,
1173 transcript => $transcript,
1174 affected_bugs => \%bug_affected,
1175 requester => $header{from},
1176 request_addr => $controlrequestaddr,
1183 } elsif (m/^archive\s+#?(\d+)$/i) {
1186 $bug_affected{$ref} = 1;
1188 bug_archive(bug => $ref,
1189 transcript => \$transcript,
1191 archive_unarchived => 0,
1192 affected_bugs => \%bug_affected,
1193 requester => $header{from},
1194 request_addr => $controlrequestaddr,
1202 print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1204 if (++$unknowns >= 5) {
1205 print {$transcript} "Too many unknown commands, stopping here.\n\n";
1210 if ($procline>$#bodylines) {
1211 print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1213 if (!$ok && !quickabort) {
1215 print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1217 print {$transcript} "\n";
1220 print {$transcript} "MC\n" if $dl>1;
1222 for $maint (keys %maintccreasons) {
1223 print {$transcript} "MM|$maint|\n" if $dl>1;
1224 next if $maint eq $replyto;
1226 $reasonsref= $maintccreasons{$maint};
1227 print {$transcript} "MY|$maint|\n" if $dl>2;
1228 for $p (sort keys %$reasonsref) {
1229 print {$transcript} "MP|$p|\n" if $dl>2;
1230 $reasonstring.= ', ' if length($reasonstring);
1231 $reasonstring.= $p.' ' if length($p);
1232 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1234 if (length($reasonstring) > 40) {
1235 (substr $reasonstring, 37) = "...";
1237 $reasonstring = "" if (!defined($reasonstring));
1238 push(@maintccs,"$maint ($reasonstring)");
1239 push(@maintccaddrs,"$maint");
1244 print {$transcript} "MC|@maintccs|\n" if $dl>2;
1245 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
1249 for my $maint (keys %maintccreasons) {
1250 for my $package (keys %{$maintccreasons{$maint}}) {
1251 next unless length $package;
1252 $packagepr{$package} = 1;
1256 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1258 # Add Bcc's to subscribed bugs
1259 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1261 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1262 $header{'subject'} = "your mail";
1265 # Error text here advertises how many errors there were
1266 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1269 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1271 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1272 In-Reply-To: $header{'message-id'}
1273 References: $header{'message-id'}
1274 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1276 ${packagepr}X-$gProject-PR-Message: transcript
1278 ${transcript}Please contact me if you need assistance.
1281 (administrator, $gProject $gBugs database)
1285 $repliedshow= join(', ',$replyto,@maintccaddrs);
1286 # -1 is the service.in log
1287 &filelock("lock/-1");
1288 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1290 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1292 "<strong>Request received</strong> from <code>".
1293 html_escape($header{'from'})."</code>\n".
1294 "to <code>".html_escape($controlrequestaddr)."</code>\n".
1296 "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1297 close(AP) || die "open db-h/-1.log: $!";
1299 utime(time,time,"db-h");
1301 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1303 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1305 sub sendmailmessage {
1306 local ($message,@recips) = @_;
1307 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1308 send_mail_message(message => $message,
1309 recipients => \@recips,
1315 my ($template,$extra_var) = @_;
1317 my $variables = {config => \%config,
1318 defined($ref)?(ref => $ref):(),
1319 defined($data)?(data => $data):(),
1322 my $hole_var = {'&bugurl' =>
1324 'http://'.$config{cgi_domain}.'/'.
1325 Debbugs::CGI::bug_url($_[0]);
1328 return fill_in_template(template => $template,
1329 variables => $variables,
1330 hole_var => $hole_var,
1334 =head2 message_body_template
1336 message_body_template('mail/ack',{ref=>'foo'});
1338 Creates a message body using a template
1342 sub message_body_template{
1343 my ($template,$extra_var) = @_;
1345 my $body = fill_template($template,$extra_var);
1346 return fill_template('mail/message_body',
1354 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1355 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1359 #sub unimplemented {
1360 # print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1364 local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1366 if (@newmergelist) {
1367 eval "\$mvarvalue= \$$mvarname";
1368 print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1371 "Values for \`$string' don't match:\n".
1372 " #$newmergelist[0] has \`$mvarvalue';\n".
1373 " #$ref has \`$svarvalue'\n"
1374 if $mvarvalue ne $svarvalue;
1376 print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1378 eval "\$$mvarname= \$svarvalue";
1383 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1384 print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1396 my %h = map { $_ => 1 } split ' ', $list;
1403 return join ' ', sort keys %h;
1406 # High-level bug manipulation calls
1407 # Do announcements themselves
1409 # Possible calling sequences:
1410 # setbug (returns 0)
1412 # setbug (returns 1)
1413 # &transcript(something)
1416 # setbug (returns 1)
1417 # $action= (something)
1419 # (modify s_* variables)
1420 # } while (getnextbug);
1423 &dlen("nochangebug");
1424 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1426 &endmerge if $manybugs;
1428 &dlex("nochangebug");
1432 &dlen("setbug $ref");
1433 if ($ref =~ m/^-\d+/) {
1434 if (!defined $clonebugs{$ref}) {
1436 &dlex("setbug => noclone");
1439 $ref = $clonebugs{$ref};
1441 $state eq 'idle' || die "$state ?";
1444 &dlex("setbug => 0s");
1448 if (!&checkpkglimit) {
1453 @thisbugmergelist= split(/ /,$data->{mergedwith});
1454 if (!@thisbugmergelist) {
1459 &dlex("setbug => 1s");
1468 &dlex("setbug => 0mc");
1472 $state= 'multiple'; $sref=$ref;
1473 &dlex("setbug => 1m");
1478 &dlen("getnextbug");
1479 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1481 if (!$manybugs || !@thisbugmergelist) {
1482 length($action) || die;
1483 print {$transcript} "$action\n$extramessage\n";
1484 &endmerge if $manybugs;
1486 &dlex("getnextbug => 0");
1489 $ref= shift(@thisbugmergelist);
1490 &getbug || die "bug $ref disappeared";
1492 &dlex("getnextbug => 1");
1496 # Low-level bug-manipulation calls
1497 # Do no announcements
1499 # getbug (returns 0)
1501 # getbug (returns 1)
1505 # $action= (something)
1506 # getbug (returns 1)
1508 # getbug (returns 1)
1510 # [getbug (returns 0)]
1511 # &transcript("$action\n\n")
1514 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1515 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1519 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1520 &filelock('lock/merge');
1521 $mergelowstate='locked';
1527 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1529 $mergelowstate='idle';
1534 &dlen("getbug $ref");
1535 $lowstate eq 'idle' || die "$state ?";
1536 # Only use unmerged bugs here
1537 if (($data = &lockreadbug($ref,'db-h'))) {
1540 &dlex("getbug => 1");
1545 &dlex("getbug => 0");
1551 $lowstate eq 'open' || die "$state ?";
1558 &dlen("savebug $ref");
1559 $lowstate eq 'open' || die "$lowstate ?";
1560 length($action) || die;
1561 $ref == $sref || die "read $sref but saving $ref ?";
1562 append_action_to_log(bug => $ref,
1564 requester => $header{from},
1565 request_addr => $controlrequestaddr,
1569 unlockwritebug($ref, $data);
1576 print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1581 print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1588 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1589 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1595 print {$transcript} "\n";
1601 print {$transcript} "\n";
1605 sub sendtxthelpraw {
1606 local ($relpath,$description) = @_;
1608 open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1609 while(<D>) { $doc.=$_; }
1611 print {$transcript} "Sending $description in separate message.\n";
1612 &sendmailmessage(<<END.$doc,$replyto);
1613 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1615 Subject: $gProject $gBug help: $description
1616 References: $header{'message-id'}
1617 In-Reply-To: $header{'message-id'}
1618 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1620 X-$gProject-PR-Message: doc-text $relpath
1626 sub sendlynxdocraw {
1627 local ($relpath,$description) = @_;
1629 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1630 while(<L>) { $doc.=$_; }
1632 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1633 print {$transcript} "Information ($description) is not available -\n".
1634 "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1637 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1639 print {$transcript} "Sending $description.\n";
1640 &sendmailmessage(<<END.$doc,$replyto);
1641 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1643 Subject: $gProject $gBugs information: $description
1644 References: $header{'message-id'}
1645 In-Reply-To: $header{'message-id'}
1646 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1648 X-$gProject-PR-Message: doc-html $relpath
1656 my %param = validate_width(params => \@_,
1657 spec => {recipients => {type => HASHREF,
1659 bug_num => {type => SCALAR,
1663 reason => {type => SCALAR,
1666 address => {type => SCALAR|ARRAYREF,
1668 type => {type => SCALAR,
1670 regex => qr/^b?cc/i,
1674 for my $addr (make_list($param{address})) {
1675 if (lc($param{type}) eq 'bcc' and
1676 exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
1680 $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = $param{type};
1684 sub addmaintainers {
1685 # Data structure is:
1686 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1687 my %param = validate_with(params => \@_,
1688 spec => {data => {type => HASHREF,
1690 recipients => {type => HASHREF,
1695 my $anymaintfound=0; my $anymaintnotfound=0;
1696 for my $p (splitpackages($param{data}{package})) {
1698 $p =~ /([a-z0-9.+-]+)/;
1700 next unless defined $p;
1701 if (defined $config{subscription_domain}) {
1702 my @source_packages = binarytosource($p);
1703 if (@source_packages) {
1704 for my $source (@source_packages) {
1705 add_recipients(recipients => $param{recipients},
1706 addrs => "$source\@".$config{subscription_domain},
1712 add_recipients(recipients => $param{recipients},
1713 addrs => "$p\@".$config{subscription_domain},
1718 if (defined $param{data}{severity} and defined $config{strong_list} and
1719 isstrongseverity($param{data}{severity})) {
1720 add_recipients(recipients => $param{recipients},
1721 addrs => "$config{strong_list}\@".$config{list_domain},
1725 if (defined(getmaintainers->{$p})) {
1726 $addmaint= getmaintainers->{$p};
1727 print {$transcript} "MR|$addmaint|$p|$ref|\n" if $dl>2;
1728 add_recipients(recipients => $param{recipients},
1731 bug_num => $param{data}{bug_num},
1734 print "maintainer add >$p|$addmaint<\n" if $debug;
1736 print "maintainer none >$p<\n" if $debug;
1737 print {$transcript} "Warning: Unknown package '$p'\n";
1738 print {$transcript} "MR|unknown-package|$p|$ref|\n" if $dl>2;
1739 add_recipients(recipients => $param{recipients},
1740 addrs => $config{unknown_maintainer_email},
1742 bug_num => $param{data}{bug_num},
1745 if defined $config{unknown_maintainer_email} and
1746 length $config{unknown_maintainer_email};
1750 if (length $param{data}{owner}) {
1751 $addmaint = $param{data}{owner};
1752 print {$transcript} "MO|$addmaint|$param{data}{package}|$ref|\n" if $dl>2;
1753 add_recipients(recipients => $param{recipients},
1756 bug_num => $param{data}{bug_num},
1759 print "owner add >$param{data}{package}|$addmaint<\n" if $debug;
1765 local ($wherefrom,$path,$description) = @_;
1766 if ($wherefrom eq "ftp.d.o") {
1767 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1769 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1770 print {$transcript} "$description is not available.\n";
1773 print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1776 } elsif ($wherefrom eq "local") {
1778 $doc = do { local $/; <P> };
1781 print {$transcript} "internal errror: info files location unknown.\n";
1784 print {$transcript} "Sending $description.\n";
1785 &sendmailmessage(<<END.$doc,$replyto);
1786 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1788 Subject: $gProject $gBugs information: $description
1789 References: $header{'message-id'}
1790 In-Reply-To: $header{'message-id'}
1791 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1793 X-$gProject-PR-Message: getinfo
1795 $description follows:
1799 print {$transcript} "\n";