2 # $Id: service.in,v 1.110 2005/07/29 20:32:30 cjwatson Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
9 use Debbugs::MIME qw(decode_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];
79 print ">$_<\n" if $debug;
82 print ">$v=$_<\n" if $debug;
83 $header{$v} = decode_rfc1522($_);
85 print "!>$_<\n" if $debug;
89 # Strip off RFC2440-style PGP clearsigning.
90 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
91 shift @bodylines while @bodylines and length $bodylines[0];
92 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
93 for my $findsig (0 .. $#bodylines) {
94 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
95 $#bodylines = $findsig - 1;
99 map { s/^- // } @bodylines;
102 grep(s/\s+$//,@bodylines);
104 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
106 if (defined $header{'resent-from'} && !defined $header{'from'}) {
107 $header{'from'} = $header{'resent-from'};
110 defined($header{'from'}) || &quit("no From header");
112 delete $header{'reply-to'}
113 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
115 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
116 $replyto = $header{'reply-to'};
118 $replyto = $header{'from'};
121 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
123 &transcript("Processing commands for $controlrequestaddr:\n\n");
128 $mergelowstate= 'idle';
134 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
135 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
136 &transcript("This service is unavailable.\n\n");
145 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
148 for ($procline=0; $procline<=$#bodylines; $procline++) {
149 $state eq 'idle' || print "$state ?\n";
150 $lowstate eq 'idle' || print "$lowstate ?\n";
151 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
153 &transcript("Stopping processing here.\n\n");
156 $_= $bodylines[$procline]; s/\s+$//;
158 &transcript("> $_\n");
161 if (m/^stop/i || m/^quit/i || m/^--/ || m/^thank/i) {
162 &transcript("Stopping processing here.\n\n");
164 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
166 &transcript("Debug level $dl.\n\n");
167 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
169 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
170 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
172 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
173 "detailed logs for $gBug#$ref");
174 } elsif (m/^index(\s+full)?$/i) {
175 &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-summary\s+by-package$/i) {
178 &transcript("This BTS function is currently disabled, sorry.\n\n");
179 $ok++; # well, it's not really ok, but it fixes #81224 :)
180 } elsif (m/^index-summary(\s+by-number)?$/i) {
181 &transcript("This BTS function is currently disabled, sorry.\n\n");
182 $ok++; # well, it's not really ok, but it fixes #81224 :)
183 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
184 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
185 } elsif (m/^index(\s+|-)maints?$/i) {
186 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
187 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
189 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
190 "$gBug list for maintainer \`$maint'");
192 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
194 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
195 "$gBug list for package $package");
197 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
198 &transcript("This BTS function is currently disabled, sorry.\n\n");
199 $ok++; # well, it's not really ok, but it fixes #81224 :)
200 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
201 &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/^send-unmatched\s+(old|-2)$/i) {
204 &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/^getinfo\s+([\w-.]+)$/i) {
207 # the following is basically a Debian-specific kludge, but who cares
209 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
210 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
211 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
213 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
214 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
215 &sendinfo("local", "$gConfigDir/$req", "$req file");
217 &transcript("Info file $req does not exist.\n\n");
219 } elsif (m/^help/i) {
223 } elsif (m/^refcard/i) {
224 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
225 } elsif (m/^subscribe/i) {
227 There is no $gProject $gBug mailing list. If you wish to review bug reports
228 please do so via http://$gWebDomain/ or ask this mail server
230 soon: MAILINGLISTS_TEXT
232 } elsif (m/^unsubscribe/i) {
234 soon: UNSUBSCRIBE_TEXT
235 soon: MAILINGLISTS_TEXT
237 } elsif (!$control) {
239 Unknown command or malformed arguments to command.
240 (Use control\@$gEmailDomain to manipulate reports.)
243 if (++$unknowns >= 3) {
244 &transcript("Too many unknown commands, stopping here.\n\n");
247 #### interesting ones start here
248 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
251 $bug_affected{$ref}=1;
254 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
255 if (length($data->{done}) and not defined($version)) {
256 &transcript("$gBug is already closed, cannot re-close.\n\n");
261 "marked as fixed in version $version" :
263 ", send any further explanations to $data->{originator}";
265 &addmaintainers($data);
266 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
267 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
268 $data->{done}= $replyto;
269 my @keywords= split ' ', $data->{keywords};
270 if (grep $_ eq 'pending', @keywords) {
271 $extramessage= "Removed pending tag.\n";
272 $data->{keywords}= join ' ', grep $_ ne 'pending',
275 addfixedversions($data, $data->{package}, $version, 'binary');
278 From: $gMaintainerEmail ($gProject $gBug Tracking System)
279 To: $data->{originator}
280 Subject: $gBug#$ref acknowledged by developer
282 References: $header{'message-id'} $data->{msgid}
283 In-Reply-To: $data->{msgid}
284 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
285 Reply-To: $ref\@$gEmailDomain
286 X-$gProject-PR-Message: they-closed-control $ref
288 This is an automatic notification regarding your $gBug report
289 #$ref: $data->{subject},
290 which was filed against the $data->{package} package.
292 It has been marked as closed by one of the developers, namely
295 You should be hearing from them with a substantive response shortly,
296 in case you haven't already. If not, please contact them directly.
299 (administrator, $gProject $gBugs database)
302 &sendmailmessage($message,$data->{originator});
303 } while (&getnextbug);
306 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
308 $ref= $1; $newpackage= $2;
309 $bug_affected{$ref}=1;
311 $newpackage =~ y/A-Z/a-z/;
313 if (length($data->{package})) {
314 $action= "$gBug reassigned from package \`$data->{package}'".
315 " to \`$newpackage'.";
317 $action= "$gBug assigned to package \`$newpackage'.";
320 &addmaintainers($data);
321 $data->{package}= $newpackage;
322 $data->{found_versions}= [];
323 $data->{fixed_versions}= [];
324 # TODO: what if $newpackage is a source package?
325 addfoundversions($data, $data->{package}, $version, 'binary');
326 &addmaintainers($data);
327 } while (&getnextbug);
329 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
330 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
331 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
332 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
335 $bug_affected{$ref}=1;
337 if (@{$data->{fixed_versions}}) {
338 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
340 if (!length($data->{done})) {
341 &transcript("$gBug is already open, cannot reopen.\n\n");
345 $noriginator eq '' ? "$gBug reopened, originator not changed." :
346 "$gBug reopened, originator set to $noriginator.";
348 &addmaintainers($data);
349 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
350 $data->{fixed_versions}= [];
352 } while (&getnextbug);
355 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
360 if (!length($data->{done}) and not defined($version)) {
361 &transcript("$gBug is already open, cannot reopen.\n\n");
366 "$gBug marked as found in version $version." :
369 &addmaintainers($data);
370 # The 'done' field gets a bit weird with version
371 # tracking, because a bug may be closed by multiple
372 # people in different branches. Until we have something
373 # more flexible, we set it every time a bug is fixed,
374 # and clear it precisely when a found command is
375 # received for the rightmost fixed-in version, which
376 # equates to the most recent fixing of the bug, or when
377 # a versionless found command is received.
378 if (defined $version) {
380 (reverse @{$data->{fixed_versions}})[0];
381 # TODO: what if $data->{package} is a source package?
382 addfoundversions($data, $data->{package}, $version, 'binary');
383 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
387 # Versionless found; assume old-style "not fixed at
389 $data->{fixed_versions} = [];
392 } while (&getnextbug);
395 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
400 $action= "$gBug marked as not found in version $version.";
401 if (length($data->{done})) {
402 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
405 &addmaintainers($data);
406 removefoundversions($data, $data->{package}, $version, 'binary');
407 } while (&getnextbug);
409 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
410 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
413 $bug_affected{$ref}=1;
414 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
415 $ref = $clonebugs{$ref};
418 if (&checkpkglimit) {
420 &addmaintainers($data);
421 $oldsubmitter= $data->{originator};
422 $data->{originator}= $newsubmitter;
423 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
425 &transcript("$action\n");
426 if (length($data->{done})) {
427 &transcript("(By the way, that $gBug is currently marked as done.)\n");
431 From: $gMaintainerEmail ($gProject $gBug Tracking System)
433 Subject: $gBug#$ref submitter address changed
435 References: $header{'message-id'} $data->{msgid}
436 In-Reply-To: $data->{msgid}
437 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
438 Reply-To: $ref\@$gEmailDomain
439 X-$gProject-PR-Message: submitter-changed $ref
441 The submitter address recorded for your $gBug report
442 #$ref: $data->{subject}
445 The old submitter address for this report was
447 The new submitter address is
450 This change was made by
452 If it was incorrect, please contact them directly.
455 (administrator, $gProject $gBugs database)
458 &sendmailmessage($message,$oldsubmitter);
465 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
467 $ref= $1; $whereto= $2;
468 $bug_affected{$ref}=1;
470 if (length($data->{forwarded})) {
471 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
473 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
475 if (length($data->{done})) {
476 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
479 &addmaintainers($data);
480 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
481 &addccaddress("$gForwardList\@$gListDomain");
483 $data->{forwarded}= $whereto;
484 } while (&getnextbug);
486 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
489 $bug_affected{$ref}=1;
491 if (!length($data->{forwarded})) {
492 &transcript("$gBug is not marked as having been forwarded.\n\n");
495 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
497 &addmaintainers($data);
498 $data->{forwarded}= '';
499 } while (&getnextbug);
502 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
503 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
506 $bug_affected{$ref}=1;
508 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
509 &transcript("Severity level \`$newseverity' is not known.\n".
510 "Recognized are: $gShowSeverities.\n\n");
511 } elsif (exists $gObsoleteSeverities{$newseverity}) {
512 &transcript("Severity level \`$newseverity' is obsolete. " .
513 "$gObsoleteSeverities{$newseverity}\n\n");
515 $printseverity= $data->{severity};
516 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
517 $action= "Severity set to \`$newseverity' from \`$printseverity'";
519 &addmaintainers($data);
520 if (defined $gStrongList and isstrongseverity($newseverity)) {
521 addbcc("$gStrongList\@$gListDomain");
523 $data->{severity}= $newseverity;
524 } while (&getnextbug);
526 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
528 $ref = $1; $addsubcode = $3; $tags = $4;
529 $bug_affected{$ref}=1;
531 if (defined $addsubcode) {
532 $addsub = "sub" if ($addsubcode eq "-");
533 $addsub = "add" if ($addsubcode eq "+");
534 $addsub = "set" if ($addsubcode eq "=");
538 foreach my $t (split /[\s,]+/, $tags) {
539 if (!grep($_ eq $t, @gTags)) {
546 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
547 "Recognized are: ".join(' ', @gTags).".\n\n");
550 if ($data->{keywords} eq '') {
551 &transcript("There were no tags set.\n");
553 &transcript("Tags were: $data->{keywords}\n");
555 if ($addsub eq "set") {
556 $action= "Tags set to: " . join(", ", @okaytags);
557 } elsif ($addsub eq "add") {
558 $action= "Tags added: " . join(", ", @okaytags);
559 } elsif ($addsub eq "sub") {
560 $action= "Tags removed: " . join(", ", @okaytags);
563 &addmaintainers($data);
564 $data->{keywords} = '' if ($addsub eq "set");
565 # Allow removing obsolete tags.
566 if ($addsub eq "sub") {
567 foreach my $t (@badtags) {
568 $data->{keywords} = join ' ', grep $_ ne $t,
569 split ' ', $data->{keywords};
572 # Now process all other additions and subtractions.
573 foreach my $t (@okaytags) {
574 $data->{keywords} = join ' ', grep $_ ne $t,
575 split ' ', $data->{keywords};
576 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
578 $data->{keywords} =~ s/\s*$//;
579 } while (&getnextbug);
581 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
583 $ref= $1; $newtitle= $2;
584 $bug_affected{$ref}=1;
585 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
586 $ref = $clonebugs{$ref};
589 if (&checkpkglimit) {
591 &addmaintainers($data);
592 $data->{subject}= $newtitle;
593 $action= "Changed $gBug title.";
595 &transcript("$action\n");
596 if (length($data->{done})) {
597 &transcript("(By the way, that $gBug is currently marked as done.)\n");
606 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
609 $bug_affected{$ref} = 1;
611 if (!length($data->{mergedwith})) {
612 &transcript("$gBug is not marked as being merged with any others.\n\n");
615 $mergelowstate eq 'locked' || die "$mergelowstate ?";
616 $action= "Disconnected #$ref from all other report(s).";
617 @newmergelist= split(/ /,$data->{mergedwith});
619 @bug_affected{@newmergelist} = 1 x @newmergelist;
621 &addmaintainers($data);
622 $data->{mergedwith}= ($ref == $discref) ? ''
623 : join(' ',grep($_ ne $ref,@newmergelist));
624 } while (&getnextbug);
627 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
629 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
635 while (defined($ref= shift(@tomerge))) {
636 &transcript("D| checking merge $ref\n") if $dl;
638 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
639 $ref = $clonebugs{$ref};
641 next if grep($_ eq $ref,@newmergelist);
642 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
643 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
645 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
647 &checkmatch('package','m_package',$data->{package});
648 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
649 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
650 &checkmatch('severity','m_severity',$data->{severity});
651 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
652 &checkmatch('owner','m_owner',$data->{owner});
653 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
654 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
655 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
656 if (length($mismatch)) {
657 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
659 &cancelbug; @newmergelist=(); last;
661 push(@newmergelist,$ref);
662 push(@tomerge,split(/ /,$data->{mergedwith}));
666 @newmergelist= sort { $a <=> $b } @newmergelist;
667 $action= "Merged @newmergelist.";
668 delete @fixed{keys %found};
669 for $ref (@newmergelist) {
670 &getbug || die "huh ? $gBug $ref disappeared during merge";
671 &addmaintainers($data);
672 @bug_affected{@newmergelist} = 1 x @newmergelist;
673 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
674 $data->{keywords}= join(' ', keys %tags);
675 $data->{found_versions}= [sort keys %found];
676 $data->{fixed_versions}= [sort keys %fixed];
679 &transcript("$action\n\n");
682 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
686 @newclonedids = split /\s+/, $2;
687 $newbugsneeded = scalar(@newclonedids);
690 $bug_affected{$ref} = 1;
692 if (length($data->{mergedwith})) {
693 &transcript("$gBug is marked as being merged with others.\n\n");
696 &filelock("nextnumber.lock");
697 open(N,"nextnumber") || &quit("nextnumber: read: $!");
698 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
699 $firstref= $v+0; $v += $newbugsneeded;
700 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
703 $lastref = $firstref + $newbugsneeded - 1;
705 if ($newbugsneeded == 1) {
706 $action= "$gBug $origref cloned as bug $firstref.";
708 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
711 my $ohash = get_hashname($origref);
713 @bug_affected{@newclonedids} = 1 x @newclonedids;
714 for $newclonedid (@newclonedids) {
715 $clonebugs{$newclonedid} = $ref;
717 my $hash = get_hashname($ref);
718 copy("db-h/$ohash/$origref.log", "db-h/$hash/$ref.log");
719 copy("db-h/$ohash/$origref.status", "db-h/$hash/$ref.status");
720 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$ref.summary");
721 copy("db-h/$ohash/$origref.report", "db-h/$hash/$ref.report");
722 &bughook('new', $ref, $data);
728 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
730 my @pkgs = split /\s+/, $1;
731 if (scalar(@pkgs) > 0) {
732 %limit_pkgs = map { ($_, 1) } @pkgs;
733 &transcript("Ignoring bugs not assigned to: " .
734 join(" ", keys(%limit_pkgs)) . "\n\n");
737 &transcript("Not ignoring any bugs.\n\n");
739 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
740 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
743 $bug_affected{$ref} = 1;
745 if (length $data->{owner}) {
746 $action = "Owner changed from $data->{owner} to $newowner.";
748 $action = "Owner recorded as $newowner.";
750 if (length $data->{done}) {
751 $extramessage = "(By the way, this $gBug is currently " .
752 "marked as done.)\n";
755 &addmaintainers($data);
756 $data->{owner} = $newowner;
757 } while (&getnextbug);
759 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
762 $bug_affected{$ref} = 1;
764 if (length $data->{owner}) {
765 $action = "Removed annotation that $gBug was owned by " .
768 &addmaintainers($data);
770 } while (&getnextbug);
772 &transcript("$gBug is not marked as having an owner.\n\n");
777 &transcript("Unknown command or malformed arguments to command.\n\n");
778 if (++$unknowns >= 5) {
779 &transcript("Too many unknown commands, stopping here.\n\n");
784 if ($procline>$#bodylines) {
785 &transcript(">\nEnd of message, stopping processing here.\n\n");
787 if (!$ok && !quickabort) {
788 &transcript("No commands successfully parsed; sending the help text(s).\n");
793 &transcript("MC\n") if $dl>1;
795 for $maint (keys %maintccreasons) {
796 &transcript("MM|$maint|\n") if $dl>1;
797 next if $maint eq $replyto;
799 $reasonsref= $maintccreasons{$maint};
800 &transcript("MY|$maint|\n") if $dl>2;
801 for $p (sort keys %$reasonsref) {
802 &transcript("MP|$p|\n") if $dl>2;
803 $reasonstring.= ', ' if length($reasonstring);
804 $reasonstring.= $p.' ' if length($p);
805 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
807 if (length($reasonstring) > 40) {
808 (substr $reasonstring, 37) = "...";
810 $reasonstring = "" if (!defined($reasonstring));
811 push(@maintccs,"$maint ($reasonstring)");
812 push(@maintccaddrs,"$maint");
817 &transcript("MC|@maintccs|\n") if $dl>2;
818 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
821 # Add Bcc's to subscribed bugs
822 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
824 if (!defined $header{'subject'} || $header{'subject'} eq "") {
825 $header{'subject'} = "your mail";
829 From: $gMaintainerEmail ($gProject $gBug Tracking System)
831 ${maintccs}Subject: Processed: $header{'subject'}
832 In-Reply-To: $header{'message-id'}
833 References: $header{'message-id'}
834 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
836 X-$gProject-PR-Message: transcript
838 ${transcript}Please contact me if you need assistance.
841 (administrator, $gProject $gBugs database)
845 $repliedshow= join(', ',$replyto,@maintccaddrs);
846 &filelock("lock/-1");
847 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
849 "\2\n$repliedshow\n\5\n$reply\n\3\n".
851 "<strong>Request received</strong> from <code>".
852 &sani($header{'from'})."</code>\n".
853 "to <code>".&sani($controlrequestaddr)."</code>\n".
855 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
856 close(AP) || &quit("open db-h/-1.log: $!");
858 utime(time,time,"db-h");
860 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
862 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
864 sub sendmailmessage {
865 local ($message,@recips) = @_;
866 $message = "X-Loop: $gMaintainerEmail\n" . $message;
867 print "mailing to >@recips<\n" if $debug;
869 defined($c) || &quit("mailing forking for sendmail: $!");
870 if (!$c) { # ie, we are the child process
871 exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odb','-oem','-oi',get_addresses(@recips);
874 print(D $message) || &quit("writing to sendmail process: $!");
875 $!=0; close(D); $? && &quit("sendmail gave exit status $? ($!)");
880 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
881 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
886 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
890 local ($string,$mvarname,$svarvalue) = @_;
893 eval "\$mvarvalue= \$$mvarname";
894 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
897 "Values for \`$string' don't match:\n".
898 " #$newmergelist[0] has \`$mvarvalue';\n".
899 " #$ref has \`$svarvalue'\n"
900 if $mvarvalue ne $svarvalue;
902 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
904 eval "\$$mvarname= \$svarvalue";
909 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
910 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
916 # High-level bug manipulation calls
917 # Do announcements themselves
919 # Possible calling sequences:
923 # &transcript(something)
927 # $action= (something)
929 # (modify s_* variables)
930 # } while (getnextbug);
933 &dlen("nochangebug");
934 $state eq 'single' || $state eq 'multiple' || die "$state ?";
936 &endmerge if $manybugs;
938 &dlex("nochangebug");
942 &dlen("setbug $ref");
943 if ($ref =~ m/^-\d+/) {
944 if (!defined $clonebugs{$ref}) {
946 &dlex("setbug => noclone");
949 $ref = $clonebugs{$ref};
951 $state eq 'idle' || die "$state ?";
954 &dlex("setbug => 0s");
958 if (!&checkpkglimit) {
963 @thisbugmergelist= split(/ /,$data->{mergedwith});
964 if (!@thisbugmergelist) {
969 &dlex("setbug => 1s");
978 &dlex("setbug => 0mc");
982 $state= 'multiple'; $sref=$ref;
983 &dlex("setbug => 1m");
989 $state eq 'single' || $state eq 'multiple' || die "$state ?";
991 if (!$manybugs || !@thisbugmergelist) {
992 length($action) || die;
993 &transcript("$action\n$extramessage\n");
994 &endmerge if $manybugs;
996 &dlex("getnextbug => 0");
999 $ref= shift(@thisbugmergelist);
1000 &getbug || die "bug $ref disappeared";
1002 &dlex("getnextbug => 1");
1006 # Low-level bug-manipulation calls
1007 # Do no announcements
1009 # getbug (returns 0)
1011 # getbug (returns 1)
1015 # $action= (something)
1016 # getbug (returns 1)
1018 # getbug (returns 1)
1020 # [getbug (returns 0)]
1021 # &transcript("$action\n\n")
1024 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1025 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1029 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1030 &filelock('lock/merge');
1031 $mergelowstate='locked';
1037 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1039 $mergelowstate='idle';
1044 &dlen("getbug $ref");
1045 $lowstate eq 'idle' || die "$state ?";
1046 if (($data = &lockreadbug($ref))) {
1049 &dlex("getbug => 1");
1054 &dlex("getbug => 0");
1060 $lowstate eq 'open' || die "$state ?";
1067 &dlen("savebug $ref");
1068 $lowstate eq 'open' || die "$lowstate ?";
1069 length($action) || die;
1070 $ref == $sref || die "read $sref but saving $ref ?";
1071 my $hash = get_hashname($ref);
1072 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1075 "<strong>".&sani($action)."</strong>\n".
1076 "Request was from <code>".&sani($header{'from'})."</code>\n".
1077 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1079 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1080 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1081 unlockwritebug($ref, $data);
1088 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1093 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1097 print $_[0] if $debug;
1098 $transcript.= $_[0];
1105 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1106 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1122 sub sendtxthelpraw {
1123 local ($relpath,$description) = @_;
1125 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1126 while(<D>) { $doc.=$_; }
1128 &transcript("Sending $description in separate message.\n");
1129 &sendmailmessage(<<END.$doc,$replyto);
1130 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1132 Subject: $gProject $gBug help: $description
1133 References: $header{'message-id'}
1134 In-Reply-To: $header{'message-id'}
1135 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1137 X-$gProject-PR-Message: doc-text $relpath
1143 sub sendlynxdocraw {
1144 local ($relpath,$description) = @_;
1146 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1147 while(<L>) { $doc.=$_; }
1149 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1150 &transcript("Information ($description) is not available -\n".
1151 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1154 &transcript("Error getting $description (code $? $!):\n$doc\n");
1156 &transcript("Sending $description.\n");
1157 &sendmailmessage(<<END.$doc,$replyto);
1158 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1160 Subject: $gProject $gBugs information: $description
1161 References: $header{'message-id'}
1162 In-Reply-To: $header{'message-id'}
1163 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1165 X-$gProject-PR-Message: doc-html $relpath
1174 $maintccreasons{$cca}{''}{$ref}= 1;
1177 sub addmaintainers {
1178 # Data structure is:
1179 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1182 &ensuremaintainersloaded;
1183 $anymaintfound=0; $anymaintnotfound=0;
1184 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1186 $p =~ /([a-z0-9.+-]+)/;
1188 next unless defined $p;
1189 if (defined $gSubscriptionDomain) {
1190 if (defined($pkgsrc{$p})) {
1191 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1193 addbcc("$p\@$gSubscriptionDomain");
1196 if (defined $data->{severity} and defined $gStrongList and
1197 isstrongseverity($data->{severity})) {
1198 addbcc("$gStrongList\@$gListDomain");
1200 if (defined($maintainerof{$p})) {
1201 $addmaint= $maintainerof{$p};
1202 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1203 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1204 print "maintainer add >$p|$addmaint<\n" if $debug;
1206 print "maintainer none >$p<\n" if $debug;
1207 &transcript("Warning: Unknown package '$p'\n");
1208 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1209 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1213 if (length $data->{owner}) {
1214 $addmaint = $data->{owner};
1215 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1216 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1217 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1221 sub ensuremaintainersloaded {
1223 return if $maintainersloaded++;
1224 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1228 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1229 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1230 $maintainerof{$1}= $2;
1233 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1237 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1238 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1239 $maintainerof{$1}= $2;
1242 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1244 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1245 my ($a, $b) = ($1, $2);
1246 $pkgsrc{lc($a)} = $b;
1252 local ($wherefrom,$path,$description) = @_;
1253 if ($wherefrom eq "ftp.d.o") {
1254 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1256 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1257 &transcript("$description is not available.\n");
1260 &transcript("Error getting $description (code $? $!):\n$doc\n");
1263 } elsif ($wherefrom eq "local") {
1265 $doc = do { local $/; <P> };
1268 &transcript("internal errror: info files location unknown.\n");
1271 &transcript("Sending $description.\n");
1272 &sendmailmessage(<<END.$doc,$replyto);
1273 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1275 Subject: $gProject $gBugs information: $description
1276 References: $header{'message-id'}
1277 In-Reply-To: $header{'message-id'}
1278 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1280 X-$gProject-PR-Message: getinfo
1282 $description follows: