2 # $Id: service.in,v 1.111 2005/07/30 03:22:36 don Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
9 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
11 $config_path = '/etc/debbugs';
12 $lib_path = '/usr/lib/debbugs';
14 require "$config_path/config";
15 require "$lib_path/errorlib";
16 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
18 chdir("$gSpoolDir") || die "chdir spool: $!\n";
21 open DEBUG, ">/dev/null";
26 m/^[RC]\.\d+$/ || &quit("bad argument");
29 if (!rename("incoming/G$nn","incoming/P$nn")) {
30 $_=$!.''; m/no such file or directory/i && exit 0;
31 &quit("renaming to lock: $!");
34 open(M,"incoming/P$nn");
41 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
43 my $parser = new MIME::Parser;
44 mkdir "$gSpoolDir/mime.tmp", 0777;
45 $parser->output_under("$gSpoolDir/mime.tmp");
46 my $entity = eval { $parser->parse_data(join('',@log)) };
48 # header and decoded body respectively
49 my (@headerlines, @bodylines);
50 # Bug numbers to send e-mail to, hash so that we don't send to the
54 if ($entity and $entity->head->tags) {
55 @headerlines = @{$entity->head->header};
58 my $entity_body = getmailbody($entity);
59 @bodylines = $entity_body ? $entity_body->as_lines() : ();
62 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
64 for ($i = 0; $i <= $#msg; $i++) {
66 last unless length($_);
67 while ($msg[$i+1] =~ m/^\s/) {
71 push @headerlines, $_;
74 @bodylines = @msg[$i..$#msg];
78 $_ = decode_rfc1522($_);
80 print ">$_<\n" if $debug;
83 print ">$v=$_<\n" if $debug;
86 print "!>$_<\n" if $debug;
90 # Strip off RFC2440-style PGP clearsigning.
91 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
92 shift @bodylines while @bodylines and length $bodylines[0];
93 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
94 for my $findsig (0 .. $#bodylines) {
95 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
96 $#bodylines = $findsig - 1;
100 map { s/^- // } @bodylines;
103 grep(s/\s+$//,@bodylines);
105 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
107 if (defined $header{'resent-from'} && !defined $header{'from'}) {
108 $header{'from'} = $header{'resent-from'};
111 defined($header{'from'}) || &quit("no From header");
113 delete $header{'reply-to'}
114 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
116 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
117 $replyto = $header{'reply-to'};
119 $replyto = $header{'from'};
122 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
124 &transcript("Processing commands for $controlrequestaddr:\n\n");
129 $mergelowstate= 'idle';
135 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
136 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
137 &transcript("This service is unavailable.\n\n");
146 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
149 for ($procline=0; $procline<=$#bodylines; $procline++) {
150 $state eq 'idle' || print "$state ?\n";
151 $lowstate eq 'idle' || print "$lowstate ?\n";
152 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
154 &transcript("Stopping processing here.\n\n");
157 $_= $bodylines[$procline]; s/\s+$//;
159 &transcript("> $_\n");
162 if (m/^stop/i || m/^quit/i || m/^--/ || m/^thank/i) {
163 &transcript("Stopping processing here.\n\n");
165 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
167 &transcript("Debug level $dl.\n\n");
168 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
170 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
171 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
173 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
174 "detailed logs for $gBug#$ref");
175 } elsif (m/^index(\s+full)?$/i) {
176 &transcript("This BTS function is currently disabled, sorry.\n\n");
177 $ok++; # well, it's not really ok, but it fixes #81224 :)
178 } elsif (m/^index-summary\s+by-package$/i) {
179 &transcript("This BTS function is currently disabled, sorry.\n\n");
180 $ok++; # well, it's not really ok, but it fixes #81224 :)
181 } elsif (m/^index-summary(\s+by-number)?$/i) {
182 &transcript("This BTS function is currently disabled, sorry.\n\n");
183 $ok++; # well, it's not really ok, but it fixes #81224 :)
184 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
185 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
186 } elsif (m/^index(\s+|-)maints?$/i) {
187 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
188 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
190 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
191 "$gBug list for maintainer \`$maint'");
193 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
195 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
196 "$gBug list for package $package");
198 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
199 &transcript("This BTS function is currently disabled, sorry.\n\n");
200 $ok++; # well, it's not really ok, but it fixes #81224 :)
201 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
202 &transcript("This BTS function is currently disabled, sorry.\n\n");
203 $ok++; # well, it's not really ok, but it fixes #81224 :)
204 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
205 &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/^getinfo\s+([\w-.]+)$/i) {
208 # the following is basically a Debian-specific kludge, but who cares
210 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
211 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
212 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
214 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
215 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
216 &sendinfo("local", "$gConfigDir/$req", "$req file");
218 &transcript("Info file $req does not exist.\n\n");
220 } elsif (m/^help/i) {
224 } elsif (m/^refcard/i) {
225 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
226 } elsif (m/^subscribe/i) {
228 There is no $gProject $gBug mailing list. If you wish to review bug reports
229 please do so via http://$gWebDomain/ or ask this mail server
231 soon: MAILINGLISTS_TEXT
233 } elsif (m/^unsubscribe/i) {
235 soon: UNSUBSCRIBE_TEXT
236 soon: MAILINGLISTS_TEXT
238 } elsif (!$control) {
240 Unknown command or malformed arguments to command.
241 (Use control\@$gEmailDomain to manipulate reports.)
244 if (++$unknowns >= 3) {
245 &transcript("Too many unknown commands, stopping here.\n\n");
248 #### interesting ones start here
249 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
252 $bug_affected{$ref}=1;
255 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
256 if (length($data->{done}) and not defined($version)) {
257 &transcript("$gBug is already closed, cannot re-close.\n\n");
262 "marked as fixed in version $version" :
264 ", send any further explanations to $data->{originator}";
266 &addmaintainers($data);
267 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
268 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
269 $data->{done}= $replyto;
270 my @keywords= split ' ', $data->{keywords};
271 if (grep $_ eq 'pending', @keywords) {
272 $extramessage= "Removed pending tag.\n";
273 $data->{keywords}= join ' ', grep $_ ne 'pending',
276 addfixedversions($data, $data->{package}, $version, 'binary');
279 From: $gMaintainerEmail ($gProject $gBug Tracking System)
280 To: $data->{originator}
281 Subject: $gBug#$ref acknowledged by developer
283 References: $header{'message-id'} $data->{msgid}
284 In-Reply-To: $data->{msgid}
285 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
286 Reply-To: $ref\@$gEmailDomain
287 X-$gProject-PR-Message: they-closed-control $ref
289 This is an automatic notification regarding your $gBug report
290 #$ref: $data->{subject},
291 which was filed against the $data->{package} package.
293 It has been marked as closed by one of the developers, namely
296 You should be hearing from them with a substantive response shortly,
297 in case you haven't already. If not, please contact them directly.
300 (administrator, $gProject $gBugs database)
303 &sendmailmessage($message,$data->{originator});
304 } while (&getnextbug);
307 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
309 $ref= $1; $newpackage= $2;
310 $bug_affected{$ref}=1;
312 $newpackage =~ y/A-Z/a-z/;
314 if (length($data->{package})) {
315 $action= "$gBug reassigned from package \`$data->{package}'".
316 " to \`$newpackage'.";
318 $action= "$gBug assigned to package \`$newpackage'.";
321 &addmaintainers($data);
322 $data->{package}= $newpackage;
323 $data->{found_versions}= [];
324 $data->{fixed_versions}= [];
325 # TODO: what if $newpackage is a source package?
326 addfoundversions($data, $data->{package}, $version, 'binary');
327 &addmaintainers($data);
328 } while (&getnextbug);
330 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
331 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
332 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
333 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
336 $bug_affected{$ref}=1;
338 if (@{$data->{fixed_versions}}) {
339 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
341 if (!length($data->{done})) {
342 &transcript("$gBug is already open, cannot reopen.\n\n");
346 $noriginator eq '' ? "$gBug reopened, originator not changed." :
347 "$gBug reopened, originator set to $noriginator.";
349 &addmaintainers($data);
350 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
351 $data->{fixed_versions}= [];
353 } while (&getnextbug);
356 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
361 if (!length($data->{done}) and not defined($version)) {
362 &transcript("$gBug is already open, cannot reopen.\n\n");
367 "$gBug marked as found in version $version." :
370 &addmaintainers($data);
371 # The 'done' field gets a bit weird with version
372 # tracking, because a bug may be closed by multiple
373 # people in different branches. Until we have something
374 # more flexible, we set it every time a bug is fixed,
375 # and clear it precisely when a found command is
376 # received for the rightmost fixed-in version, which
377 # equates to the most recent fixing of the bug, or when
378 # a versionless found command is received.
379 if (defined $version) {
381 (reverse @{$data->{fixed_versions}})[0];
382 # TODO: what if $data->{package} is a source package?
383 addfoundversions($data, $data->{package}, $version, 'binary');
384 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
388 # Versionless found; assume old-style "not fixed at
390 $data->{fixed_versions} = [];
393 } while (&getnextbug);
396 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
401 $action= "$gBug marked as not found in version $version.";
402 if (length($data->{done})) {
403 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
406 &addmaintainers($data);
407 removefoundversions($data, $data->{package}, $version, 'binary');
408 } while (&getnextbug);
410 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
411 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
414 $bug_affected{$ref}=1;
415 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
416 $ref = $clonebugs{$ref};
419 if (&checkpkglimit) {
421 &addmaintainers($data);
422 $oldsubmitter= $data->{originator};
423 $data->{originator}= $newsubmitter;
424 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
426 &transcript("$action\n");
427 if (length($data->{done})) {
428 &transcript("(By the way, that $gBug is currently marked as done.)\n");
432 From: $gMaintainerEmail ($gProject $gBug Tracking System)
434 Subject: $gBug#$ref submitter address changed
436 References: $header{'message-id'} $data->{msgid}
437 In-Reply-To: $data->{msgid}
438 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
439 Reply-To: $ref\@$gEmailDomain
440 X-$gProject-PR-Message: submitter-changed $ref
442 The submitter address recorded for your $gBug report
443 #$ref: $data->{subject}
446 The old submitter address for this report was
448 The new submitter address is
451 This change was made by
453 If it was incorrect, please contact them directly.
456 (administrator, $gProject $gBugs database)
459 &sendmailmessage($message,$oldsubmitter);
466 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
468 $ref= $1; $whereto= $2;
469 $bug_affected{$ref}=1;
471 if (length($data->{forwarded})) {
472 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
474 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
476 if (length($data->{done})) {
477 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
480 &addmaintainers($data);
481 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
482 &addccaddress("$gForwardList\@$gListDomain");
484 $data->{forwarded}= $whereto;
485 } while (&getnextbug);
487 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
490 $bug_affected{$ref}=1;
492 if (!length($data->{forwarded})) {
493 &transcript("$gBug is not marked as having been forwarded.\n\n");
496 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
498 &addmaintainers($data);
499 $data->{forwarded}= '';
500 } while (&getnextbug);
503 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
504 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
507 $bug_affected{$ref}=1;
509 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
510 &transcript("Severity level \`$newseverity' is not known.\n".
511 "Recognized are: $gShowSeverities.\n\n");
512 } elsif (exists $gObsoleteSeverities{$newseverity}) {
513 &transcript("Severity level \`$newseverity' is obsolete. " .
514 "$gObsoleteSeverities{$newseverity}\n\n");
516 $printseverity= $data->{severity};
517 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
518 $action= "Severity set to \`$newseverity' from \`$printseverity'";
520 &addmaintainers($data);
521 if (defined $gStrongList and isstrongseverity($newseverity)) {
522 addbcc("$gStrongList\@$gListDomain");
524 $data->{severity}= $newseverity;
525 } while (&getnextbug);
527 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
529 $ref = $1; $addsubcode = $3; $tags = $4;
530 $bug_affected{$ref}=1;
532 if (defined $addsubcode) {
533 $addsub = "sub" if ($addsubcode eq "-");
534 $addsub = "add" if ($addsubcode eq "+");
535 $addsub = "set" if ($addsubcode eq "=");
539 foreach my $t (split /[\s,]+/, $tags) {
540 if (!grep($_ eq $t, @gTags)) {
547 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
548 "Recognized are: ".join(' ', @gTags).".\n\n");
551 if ($data->{keywords} eq '') {
552 &transcript("There were no tags set.\n");
554 &transcript("Tags were: $data->{keywords}\n");
556 if ($addsub eq "set") {
557 $action= "Tags set to: " . join(", ", @okaytags);
558 } elsif ($addsub eq "add") {
559 $action= "Tags added: " . join(", ", @okaytags);
560 } elsif ($addsub eq "sub") {
561 $action= "Tags removed: " . join(", ", @okaytags);
564 &addmaintainers($data);
565 $data->{keywords} = '' if ($addsub eq "set");
566 # Allow removing obsolete tags.
567 if ($addsub eq "sub") {
568 foreach my $t (@badtags) {
569 $data->{keywords} = join ' ', grep $_ ne $t,
570 split ' ', $data->{keywords};
573 # Now process all other additions and subtractions.
574 foreach my $t (@okaytags) {
575 $data->{keywords} = join ' ', grep $_ ne $t,
576 split ' ', $data->{keywords};
577 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
579 $data->{keywords} =~ s/\s*$//;
580 } while (&getnextbug);
582 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
584 $ref= $1; $newtitle= $2;
585 $bug_affected{$ref}=1;
586 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
587 $ref = $clonebugs{$ref};
590 if (&checkpkglimit) {
592 &addmaintainers($data);
593 $data->{subject}= $newtitle;
594 $action= "Changed $gBug title.";
596 &transcript("$action\n");
597 if (length($data->{done})) {
598 &transcript("(By the way, that $gBug is currently marked as done.)\n");
607 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
610 $bug_affected{$ref} = 1;
612 if (!length($data->{mergedwith})) {
613 &transcript("$gBug is not marked as being merged with any others.\n\n");
616 $mergelowstate eq 'locked' || die "$mergelowstate ?";
617 $action= "Disconnected #$ref from all other report(s).";
618 @newmergelist= split(/ /,$data->{mergedwith});
620 @bug_affected{@newmergelist} = 1 x @newmergelist;
622 &addmaintainers($data);
623 $data->{mergedwith}= ($ref == $discref) ? ''
624 : join(' ',grep($_ ne $ref,@newmergelist));
625 } while (&getnextbug);
628 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
630 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
636 while (defined($ref= shift(@tomerge))) {
637 &transcript("D| checking merge $ref\n") if $dl;
639 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
640 $ref = $clonebugs{$ref};
642 next if grep($_ eq $ref,@newmergelist);
643 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
644 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
646 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
648 &checkmatch('package','m_package',$data->{package});
649 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
650 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
651 &checkmatch('severity','m_severity',$data->{severity});
652 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
653 &checkmatch('owner','m_owner',$data->{owner});
654 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
655 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
656 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
657 if (length($mismatch)) {
658 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
660 &cancelbug; @newmergelist=(); last;
662 push(@newmergelist,$ref);
663 push(@tomerge,split(/ /,$data->{mergedwith}));
667 @newmergelist= sort { $a <=> $b } @newmergelist;
668 $action= "Merged @newmergelist.";
669 delete @fixed{keys %found};
670 for $ref (@newmergelist) {
671 &getbug || die "huh ? $gBug $ref disappeared during merge";
672 &addmaintainers($data);
673 @bug_affected{@newmergelist} = 1 x @newmergelist;
674 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
675 $data->{keywords}= join(' ', keys %tags);
676 $data->{found_versions}= [sort keys %found];
677 $data->{fixed_versions}= [sort keys %fixed];
680 &transcript("$action\n\n");
683 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
687 @newclonedids = split /\s+/, $2;
688 $newbugsneeded = scalar(@newclonedids);
691 $bug_affected{$ref} = 1;
693 if (length($data->{mergedwith})) {
694 &transcript("$gBug is marked as being merged with others.\n\n");
697 &filelock("nextnumber.lock");
698 open(N,"nextnumber") || &quit("nextnumber: read: $!");
699 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
700 $firstref= $v+0; $v += $newbugsneeded;
701 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
704 $lastref = $firstref + $newbugsneeded - 1;
706 if ($newbugsneeded == 1) {
707 $action= "$gBug $origref cloned as bug $firstref.";
709 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
712 my $ohash = get_hashname($origref);
714 @bug_affected{@newclonedids} = 1 x @newclonedids;
715 for $newclonedid (@newclonedids) {
716 $clonebugs{$newclonedid} = $ref;
718 my $hash = get_hashname($ref);
719 copy("db-h/$ohash/$origref.log", "db-h/$hash/$ref.log");
720 copy("db-h/$ohash/$origref.status", "db-h/$hash/$ref.status");
721 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$ref.summary");
722 copy("db-h/$ohash/$origref.report", "db-h/$hash/$ref.report");
723 &bughook('new', $ref, $data);
729 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
731 my @pkgs = split /\s+/, $1;
732 if (scalar(@pkgs) > 0) {
733 %limit_pkgs = map { ($_, 1) } @pkgs;
734 &transcript("Ignoring bugs not assigned to: " .
735 join(" ", keys(%limit_pkgs)) . "\n\n");
738 &transcript("Not ignoring any bugs.\n\n");
740 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
741 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
744 $bug_affected{$ref} = 1;
746 if (length $data->{owner}) {
747 $action = "Owner changed from $data->{owner} to $newowner.";
749 $action = "Owner recorded as $newowner.";
751 if (length $data->{done}) {
752 $extramessage = "(By the way, this $gBug is currently " .
753 "marked as done.)\n";
756 &addmaintainers($data);
757 $data->{owner} = $newowner;
758 } while (&getnextbug);
760 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
763 $bug_affected{$ref} = 1;
765 if (length $data->{owner}) {
766 $action = "Removed annotation that $gBug was owned by " .
769 &addmaintainers($data);
771 } while (&getnextbug);
773 &transcript("$gBug is not marked as having an owner.\n\n");
778 &transcript("Unknown command or malformed arguments to command.\n\n");
779 if (++$unknowns >= 5) {
780 &transcript("Too many unknown commands, stopping here.\n\n");
785 if ($procline>$#bodylines) {
786 &transcript(">\nEnd of message, stopping processing here.\n\n");
788 if (!$ok && !quickabort) {
789 &transcript("No commands successfully parsed; sending the help text(s).\n");
794 &transcript("MC\n") if $dl>1;
796 for $maint (keys %maintccreasons) {
797 &transcript("MM|$maint|\n") if $dl>1;
798 next if $maint eq $replyto;
800 $reasonsref= $maintccreasons{$maint};
801 &transcript("MY|$maint|\n") if $dl>2;
802 for $p (sort keys %$reasonsref) {
803 &transcript("MP|$p|\n") if $dl>2;
804 $reasonstring.= ', ' if length($reasonstring);
805 $reasonstring.= $p.' ' if length($p);
806 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
808 if (length($reasonstring) > 40) {
809 (substr $reasonstring, 37) = "...";
811 $reasonstring = "" if (!defined($reasonstring));
812 push(@maintccs,"$maint ($reasonstring)");
813 push(@maintccaddrs,"$maint");
818 &transcript("MC|@maintccs|\n") if $dl>2;
819 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
822 # Add Bcc's to subscribed bugs
823 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
825 if (!defined $header{'subject'} || $header{'subject'} eq "") {
826 $header{'subject'} = "your mail";
830 From: $gMaintainerEmail ($gProject $gBug Tracking System)
832 ${maintccs}Subject: Processed: $header{'subject'}
833 In-Reply-To: $header{'message-id'}
834 References: $header{'message-id'}
835 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
837 X-$gProject-PR-Message: transcript
839 ${transcript}Please contact me if you need assistance.
842 (administrator, $gProject $gBugs database)
846 $repliedshow= join(', ',$replyto,@maintccaddrs);
847 &filelock("lock/-1");
848 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
850 "\2\n$repliedshow\n\5\n$reply\n\3\n".
852 "<strong>Request received</strong> from <code>".
853 &sani($header{'from'})."</code>\n".
854 "to <code>".&sani($controlrequestaddr)."</code>\n".
856 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
857 close(AP) || &quit("open db-h/-1.log: $!");
859 utime(time,time,"db-h");
861 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
863 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
865 sub sendmailmessage {
866 local ($message,@recips) = @_;
867 $message = "X-Loop: $gMaintainerEmail\n" . $message;
868 # The original message received is written out above, so before
869 # writing out the other messages we've sent out, we need to
870 # RFC1522 encode the header.
871 my ($header,$body) = split /\n\n/, $message, 2;
872 $header = encode_rfc1522($header);
873 $message = $header . qq(\n\n). $body;
875 print "mailing to >@recips<\n" if $debug;
877 defined($c) || &quit("mailing forking for sendmail: $!");
878 if (!$c) { # ie, we are the child process
879 exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odb','-oem','-oi',get_addresses(@recips);
882 print(D $message) || &quit("writing to sendmail process: $!");
883 $!=0; close(D); $? && &quit("sendmail gave exit status $? ($!)");
888 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
889 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
894 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
898 local ($string,$mvarname,$svarvalue) = @_;
901 eval "\$mvarvalue= \$$mvarname";
902 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
905 "Values for \`$string' don't match:\n".
906 " #$newmergelist[0] has \`$mvarvalue';\n".
907 " #$ref has \`$svarvalue'\n"
908 if $mvarvalue ne $svarvalue;
910 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
912 eval "\$$mvarname= \$svarvalue";
917 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
918 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
924 # High-level bug manipulation calls
925 # Do announcements themselves
927 # Possible calling sequences:
931 # &transcript(something)
935 # $action= (something)
937 # (modify s_* variables)
938 # } while (getnextbug);
941 &dlen("nochangebug");
942 $state eq 'single' || $state eq 'multiple' || die "$state ?";
944 &endmerge if $manybugs;
946 &dlex("nochangebug");
950 &dlen("setbug $ref");
951 if ($ref =~ m/^-\d+/) {
952 if (!defined $clonebugs{$ref}) {
954 &dlex("setbug => noclone");
957 $ref = $clonebugs{$ref};
959 $state eq 'idle' || die "$state ?";
962 &dlex("setbug => 0s");
966 if (!&checkpkglimit) {
971 @thisbugmergelist= split(/ /,$data->{mergedwith});
972 if (!@thisbugmergelist) {
977 &dlex("setbug => 1s");
986 &dlex("setbug => 0mc");
990 $state= 'multiple'; $sref=$ref;
991 &dlex("setbug => 1m");
997 $state eq 'single' || $state eq 'multiple' || die "$state ?";
999 if (!$manybugs || !@thisbugmergelist) {
1000 length($action) || die;
1001 &transcript("$action\n$extramessage\n");
1002 &endmerge if $manybugs;
1004 &dlex("getnextbug => 0");
1007 $ref= shift(@thisbugmergelist);
1008 &getbug || die "bug $ref disappeared";
1010 &dlex("getnextbug => 1");
1014 # Low-level bug-manipulation calls
1015 # Do no announcements
1017 # getbug (returns 0)
1019 # getbug (returns 1)
1023 # $action= (something)
1024 # getbug (returns 1)
1026 # getbug (returns 1)
1028 # [getbug (returns 0)]
1029 # &transcript("$action\n\n")
1032 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1033 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1037 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1038 &filelock('lock/merge');
1039 $mergelowstate='locked';
1045 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1047 $mergelowstate='idle';
1052 &dlen("getbug $ref");
1053 $lowstate eq 'idle' || die "$state ?";
1054 if (($data = &lockreadbug($ref))) {
1057 &dlex("getbug => 1");
1062 &dlex("getbug => 0");
1068 $lowstate eq 'open' || die "$state ?";
1075 &dlen("savebug $ref");
1076 $lowstate eq 'open' || die "$lowstate ?";
1077 length($action) || die;
1078 $ref == $sref || die "read $sref but saving $ref ?";
1079 my $hash = get_hashname($ref);
1080 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1083 "<strong>".&sani($action)."</strong>\n".
1084 "Request was from <code>".&sani($header{'from'})."</code>\n".
1085 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1087 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1088 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1089 unlockwritebug($ref, $data);
1096 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1101 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1105 print $_[0] if $debug;
1106 $transcript.= $_[0];
1113 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1114 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1130 sub sendtxthelpraw {
1131 local ($relpath,$description) = @_;
1133 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1134 while(<D>) { $doc.=$_; }
1136 &transcript("Sending $description in separate message.\n");
1137 &sendmailmessage(<<END.$doc,$replyto);
1138 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1140 Subject: $gProject $gBug help: $description
1141 References: $header{'message-id'}
1142 In-Reply-To: $header{'message-id'}
1143 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1145 X-$gProject-PR-Message: doc-text $relpath
1151 sub sendlynxdocraw {
1152 local ($relpath,$description) = @_;
1154 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1155 while(<L>) { $doc.=$_; }
1157 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1158 &transcript("Information ($description) is not available -\n".
1159 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1162 &transcript("Error getting $description (code $? $!):\n$doc\n");
1164 &transcript("Sending $description.\n");
1165 &sendmailmessage(<<END.$doc,$replyto);
1166 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1168 Subject: $gProject $gBugs information: $description
1169 References: $header{'message-id'}
1170 In-Reply-To: $header{'message-id'}
1171 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1173 X-$gProject-PR-Message: doc-html $relpath
1182 $maintccreasons{$cca}{''}{$ref}= 1;
1185 sub addmaintainers {
1186 # Data structure is:
1187 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1190 &ensuremaintainersloaded;
1191 $anymaintfound=0; $anymaintnotfound=0;
1192 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1194 $p =~ /([a-z0-9.+-]+)/;
1196 next unless defined $p;
1197 if (defined $gSubscriptionDomain) {
1198 if (defined($pkgsrc{$p})) {
1199 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1201 addbcc("$p\@$gSubscriptionDomain");
1204 if (defined $data->{severity} and defined $gStrongList and
1205 isstrongseverity($data->{severity})) {
1206 addbcc("$gStrongList\@$gListDomain");
1208 if (defined($maintainerof{$p})) {
1209 $addmaint= $maintainerof{$p};
1210 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1211 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1212 print "maintainer add >$p|$addmaint<\n" if $debug;
1214 print "maintainer none >$p<\n" if $debug;
1215 &transcript("Warning: Unknown package '$p'\n");
1216 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1217 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1221 if (length $data->{owner}) {
1222 $addmaint = $data->{owner};
1223 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1224 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1225 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1229 sub ensuremaintainersloaded {
1231 return if $maintainersloaded++;
1232 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1236 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1237 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1238 $maintainerof{$1}= $2;
1241 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1245 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1246 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1247 $maintainerof{$1}= $2;
1250 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1252 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1253 my ($a, $b) = ($1, $2);
1254 $pkgsrc{lc($a)} = $b;
1260 local ($wherefrom,$path,$description) = @_;
1261 if ($wherefrom eq "ftp.d.o") {
1262 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1264 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1265 &transcript("$description is not available.\n");
1268 &transcript("Error getting $description (code $? $!):\n$doc\n");
1271 } elsif ($wherefrom eq "local") {
1273 $doc = do { local $/; <P> };
1276 &transcript("internal errror: info files location unknown.\n");
1279 &transcript("Sending $description.\n");
1280 &sendmailmessage(<<END.$doc,$replyto);
1281 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1283 Subject: $gProject $gBugs information: $description
1284 References: $header{'message-id'}
1285 In-Reply-To: $header{'message-id'}
1286 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1288 X-$gProject-PR-Message: getinfo
1290 $description follows: