2 # $Id: service.in,v 1.112 2005/08/17 21:46:17 don Exp $
4 # Usage: service <code>.nn
5 # Temps: incoming/P<code>.nn
9 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
10 use Debbugs::Mail qw(send_mail_message);
12 $config_path = '/etc/debbugs';
13 $lib_path = '/usr/lib/debbugs';
15 require "$config_path/config";
16 require "$lib_path/errorlib";
17 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
19 chdir("$gSpoolDir") || die "chdir spool: $!\n";
22 open DEBUG, ">/dev/null";
27 m/^[RC]\.\d+$/ || &quit("bad argument");
30 if (!rename("incoming/G$nn","incoming/P$nn")) {
31 $_=$!.''; m/no such file or directory/i && exit 0;
32 &quit("renaming to lock: $!");
35 open(M,"incoming/P$nn");
42 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
44 my $parser = new MIME::Parser;
45 mkdir "$gSpoolDir/mime.tmp", 0777;
46 $parser->output_under("$gSpoolDir/mime.tmp");
47 my $entity = eval { $parser->parse_data(join('',@log)) };
49 # header and decoded body respectively
50 my (@headerlines, @bodylines);
51 # Bug numbers to send e-mail to, hash so that we don't send to the
55 if ($entity and $entity->head->tags) {
56 @headerlines = @{$entity->head->header};
59 my $entity_body = getmailbody($entity);
60 @bodylines = $entity_body ? $entity_body->as_lines() : ();
63 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
65 for ($i = 0; $i <= $#msg; $i++) {
67 last unless length($_);
68 while ($msg[$i+1] =~ m/^\s/) {
72 push @headerlines, $_;
75 @bodylines = @msg[$i..$#msg];
79 $_ = decode_rfc1522($_);
81 print ">$_<\n" if $debug;
84 print ">$v=$_<\n" if $debug;
87 print "!>$_<\n" if $debug;
91 # Strip off RFC2440-style PGP clearsigning.
92 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
93 shift @bodylines while @bodylines and length $bodylines[0];
94 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
95 for my $findsig (0 .. $#bodylines) {
96 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
97 $#bodylines = $findsig - 1;
101 map { s/^- // } @bodylines;
104 grep(s/\s+$//,@bodylines);
106 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
108 if (defined $header{'resent-from'} && !defined $header{'from'}) {
109 $header{'from'} = $header{'resent-from'};
112 defined($header{'from'}) || &quit("no From header");
114 delete $header{'reply-to'}
115 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
117 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
118 $replyto = $header{'reply-to'};
120 $replyto = $header{'from'};
123 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
125 &transcript("Processing commands for $controlrequestaddr:\n\n");
130 $mergelowstate= 'idle';
136 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
137 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
138 &transcript("This service is unavailable.\n\n");
147 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
150 for ($procline=0; $procline<=$#bodylines; $procline++) {
151 $state eq 'idle' || print "$state ?\n";
152 $lowstate eq 'idle' || print "$lowstate ?\n";
153 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
155 &transcript("Stopping processing here.\n\n");
158 $_= $bodylines[$procline]; s/\s+$//;
160 &transcript("> $_\n");
163 if (m/^stop/i || m/^quit/i || m/^--/ || m/^thank/i) {
164 &transcript("Stopping processing here.\n\n");
166 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
168 &transcript("Debug level $dl.\n\n");
169 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
171 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
172 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
174 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
175 "detailed logs for $gBug#$ref");
176 } elsif (m/^index(\s+full)?$/i) {
177 &transcript("This BTS function is currently disabled, sorry.\n\n");
178 $ok++; # well, it's not really ok, but it fixes #81224 :)
179 } elsif (m/^index-summary\s+by-package$/i) {
180 &transcript("This BTS function is currently disabled, sorry.\n\n");
181 $ok++; # well, it's not really ok, but it fixes #81224 :)
182 } elsif (m/^index-summary(\s+by-number)?$/i) {
183 &transcript("This BTS function is currently disabled, sorry.\n\n");
184 $ok++; # well, it's not really ok, but it fixes #81224 :)
185 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
186 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
187 } elsif (m/^index(\s+|-)maints?$/i) {
188 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
189 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
191 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
192 "$gBug list for maintainer \`$maint'");
194 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
196 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
197 "$gBug list for package $package");
199 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
200 &transcript("This BTS function is currently disabled, sorry.\n\n");
201 $ok++; # well, it's not really ok, but it fixes #81224 :)
202 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
203 &transcript("This BTS function is currently disabled, sorry.\n\n");
204 $ok++; # well, it's not really ok, but it fixes #81224 :)
205 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
206 &transcript("This BTS function is currently disabled, sorry.\n\n");
207 $ok++; # well, it's not really ok, but it fixes #81224 :)
208 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
209 # the following is basically a Debian-specific kludge, but who cares
211 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
212 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
213 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
215 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
216 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
217 &sendinfo("local", "$gConfigDir/$req", "$req file");
219 &transcript("Info file $req does not exist.\n\n");
221 } elsif (m/^help/i) {
225 } elsif (m/^refcard/i) {
226 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
227 } elsif (m/^subscribe/i) {
229 There is no $gProject $gBug mailing list. If you wish to review bug reports
230 please do so via http://$gWebDomain/ or ask this mail server
232 soon: MAILINGLISTS_TEXT
234 } elsif (m/^unsubscribe/i) {
236 soon: UNSUBSCRIBE_TEXT
237 soon: MAILINGLISTS_TEXT
239 } elsif (!$control) {
241 Unknown command or malformed arguments to command.
242 (Use control\@$gEmailDomain to manipulate reports.)
245 if (++$unknowns >= 3) {
246 &transcript("Too many unknown commands, stopping here.\n\n");
249 #### interesting ones start here
250 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
253 $bug_affected{$ref}=1;
256 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
257 if (length($data->{done}) and not defined($version)) {
258 &transcript("$gBug is already closed, cannot re-close.\n\n");
263 "marked as fixed in version $version" :
265 ", send any further explanations to $data->{originator}";
267 &addmaintainers($data);
268 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
269 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
270 $data->{done}= $replyto;
271 my @keywords= split ' ', $data->{keywords};
272 if (grep $_ eq 'pending', @keywords) {
273 $extramessage= "Removed pending tag.\n";
274 $data->{keywords}= join ' ', grep $_ ne 'pending',
277 addfixedversions($data, $data->{package}, $version, 'binary');
280 From: $gMaintainerEmail ($gProject $gBug Tracking System)
281 To: $data->{originator}
282 Subject: $gBug#$ref acknowledged by developer
284 References: $header{'message-id'} $data->{msgid}
285 In-Reply-To: $data->{msgid}
286 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
287 Reply-To: $ref\@$gEmailDomain
288 X-$gProject-PR-Message: they-closed-control $ref
290 This is an automatic notification regarding your $gBug report
291 #$ref: $data->{subject},
292 which was filed against the $data->{package} package.
294 It has been marked as closed by one of the developers, namely
297 You should be hearing from them with a substantive response shortly,
298 in case you haven't already. If not, please contact them directly.
301 (administrator, $gProject $gBugs database)
304 &sendmailmessage($message,$data->{originator});
305 } while (&getnextbug);
308 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
310 $ref= $1; $newpackage= $2;
311 $bug_affected{$ref}=1;
313 $newpackage =~ y/A-Z/a-z/;
315 if (length($data->{package})) {
316 $action= "$gBug reassigned from package \`$data->{package}'".
317 " to \`$newpackage'.";
319 $action= "$gBug assigned to package \`$newpackage'.";
322 &addmaintainers($data);
323 $data->{package}= $newpackage;
324 $data->{found_versions}= [];
325 $data->{fixed_versions}= [];
326 # TODO: what if $newpackage is a source package?
327 addfoundversions($data, $data->{package}, $version, 'binary');
328 &addmaintainers($data);
329 } while (&getnextbug);
331 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
332 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
333 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
334 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
337 $bug_affected{$ref}=1;
339 if (@{$data->{fixed_versions}}) {
340 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
342 if (!length($data->{done})) {
343 &transcript("$gBug is already open, cannot reopen.\n\n");
347 $noriginator eq '' ? "$gBug reopened, originator not changed." :
348 "$gBug reopened, originator set to $noriginator.";
350 &addmaintainers($data);
351 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
352 $data->{fixed_versions}= [];
354 } while (&getnextbug);
357 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
362 if (!length($data->{done}) and not defined($version)) {
363 &transcript("$gBug is already open, cannot reopen.\n\n");
368 "$gBug marked as found in version $version." :
371 &addmaintainers($data);
372 # The 'done' field gets a bit weird with version
373 # tracking, because a bug may be closed by multiple
374 # people in different branches. Until we have something
375 # more flexible, we set it every time a bug is fixed,
376 # and clear it precisely when a found command is
377 # received for the rightmost fixed-in version, which
378 # equates to the most recent fixing of the bug, or when
379 # a versionless found command is received.
380 if (defined $version) {
382 (reverse @{$data->{fixed_versions}})[0];
383 # TODO: what if $data->{package} is a source package?
384 addfoundversions($data, $data->{package}, $version, 'binary');
385 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
389 # Versionless found; assume old-style "not fixed at
391 $data->{fixed_versions} = [];
394 } while (&getnextbug);
397 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
402 $action= "$gBug marked as not found in version $version.";
403 if (length($data->{done})) {
404 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
407 &addmaintainers($data);
408 removefoundversions($data, $data->{package}, $version, 'binary');
409 } while (&getnextbug);
411 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
412 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
415 $bug_affected{$ref}=1;
416 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
417 $ref = $clonebugs{$ref};
420 if (&checkpkglimit) {
422 &addmaintainers($data);
423 $oldsubmitter= $data->{originator};
424 $data->{originator}= $newsubmitter;
425 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
427 &transcript("$action\n");
428 if (length($data->{done})) {
429 &transcript("(By the way, that $gBug is currently marked as done.)\n");
433 From: $gMaintainerEmail ($gProject $gBug Tracking System)
435 Subject: $gBug#$ref submitter address changed
437 References: $header{'message-id'} $data->{msgid}
438 In-Reply-To: $data->{msgid}
439 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
440 Reply-To: $ref\@$gEmailDomain
441 X-$gProject-PR-Message: submitter-changed $ref
443 The submitter address recorded for your $gBug report
444 #$ref: $data->{subject}
447 The old submitter address for this report was
449 The new submitter address is
452 This change was made by
454 If it was incorrect, please contact them directly.
457 (administrator, $gProject $gBugs database)
460 &sendmailmessage($message,$oldsubmitter);
467 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
469 $ref= $1; $whereto= $2;
470 $bug_affected{$ref}=1;
472 if (length($data->{forwarded})) {
473 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
475 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
477 if (length($data->{done})) {
478 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
481 &addmaintainers($data);
482 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
483 &addccaddress("$gForwardList\@$gListDomain");
485 $data->{forwarded}= $whereto;
486 } while (&getnextbug);
488 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
491 $bug_affected{$ref}=1;
493 if (!length($data->{forwarded})) {
494 &transcript("$gBug is not marked as having been forwarded.\n\n");
497 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
499 &addmaintainers($data);
500 $data->{forwarded}= '';
501 } while (&getnextbug);
504 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
505 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
508 $bug_affected{$ref}=1;
510 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
511 &transcript("Severity level \`$newseverity' is not known.\n".
512 "Recognized are: $gShowSeverities.\n\n");
513 } elsif (exists $gObsoleteSeverities{$newseverity}) {
514 &transcript("Severity level \`$newseverity' is obsolete. " .
515 "$gObsoleteSeverities{$newseverity}\n\n");
517 $printseverity= $data->{severity};
518 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
519 $action= "Severity set to \`$newseverity' from \`$printseverity'";
521 &addmaintainers($data);
522 if (defined $gStrongList and isstrongseverity($newseverity)) {
523 addbcc("$gStrongList\@$gListDomain");
525 $data->{severity}= $newseverity;
526 } while (&getnextbug);
528 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
530 $ref = $1; $addsubcode = $3; $tags = $4;
531 $bug_affected{$ref}=1;
533 if (defined $addsubcode) {
534 $addsub = "sub" if ($addsubcode eq "-");
535 $addsub = "add" if ($addsubcode eq "+");
536 $addsub = "set" if ($addsubcode eq "=");
540 foreach my $t (split /[\s,]+/, $tags) {
541 if (!grep($_ eq $t, @gTags)) {
548 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
549 "Recognized are: ".join(' ', @gTags).".\n\n");
552 if ($data->{keywords} eq '') {
553 &transcript("There were no tags set.\n");
555 &transcript("Tags were: $data->{keywords}\n");
557 if ($addsub eq "set") {
558 $action= "Tags set to: " . join(", ", @okaytags);
559 } elsif ($addsub eq "add") {
560 $action= "Tags added: " . join(", ", @okaytags);
561 } elsif ($addsub eq "sub") {
562 $action= "Tags removed: " . join(", ", @okaytags);
565 &addmaintainers($data);
566 $data->{keywords} = '' if ($addsub eq "set");
567 # Allow removing obsolete tags.
568 if ($addsub eq "sub") {
569 foreach my $t (@badtags) {
570 $data->{keywords} = join ' ', grep $_ ne $t,
571 split ' ', $data->{keywords};
574 # Now process all other additions and subtractions.
575 foreach my $t (@okaytags) {
576 $data->{keywords} = join ' ', grep $_ ne $t,
577 split ' ', $data->{keywords};
578 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
580 $data->{keywords} =~ s/\s*$//;
581 } while (&getnextbug);
583 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
585 $ref= $1; $newtitle= $2;
586 $bug_affected{$ref}=1;
587 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
588 $ref = $clonebugs{$ref};
591 if (&checkpkglimit) {
593 &addmaintainers($data);
594 $data->{subject}= $newtitle;
595 $action= "Changed $gBug title.";
597 &transcript("$action\n");
598 if (length($data->{done})) {
599 &transcript("(By the way, that $gBug is currently marked as done.)\n");
608 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
611 $bug_affected{$ref} = 1;
613 if (!length($data->{mergedwith})) {
614 &transcript("$gBug is not marked as being merged with any others.\n\n");
617 $mergelowstate eq 'locked' || die "$mergelowstate ?";
618 $action= "Disconnected #$ref from all other report(s).";
619 @newmergelist= split(/ /,$data->{mergedwith});
621 @bug_affected{@newmergelist} = 1 x @newmergelist;
623 &addmaintainers($data);
624 $data->{mergedwith}= ($ref == $discref) ? ''
625 : join(' ',grep($_ ne $ref,@newmergelist));
626 } while (&getnextbug);
629 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
631 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
637 while (defined($ref= shift(@tomerge))) {
638 &transcript("D| checking merge $ref\n") if $dl;
640 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
641 $ref = $clonebugs{$ref};
643 next if grep($_ eq $ref,@newmergelist);
644 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
645 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
647 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
649 &checkmatch('package','m_package',$data->{package});
650 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
651 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
652 &checkmatch('severity','m_severity',$data->{severity});
653 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
654 &checkmatch('owner','m_owner',$data->{owner});
655 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
656 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
657 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
658 if (length($mismatch)) {
659 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
661 &cancelbug; @newmergelist=(); last;
663 push(@newmergelist,$ref);
664 push(@tomerge,split(/ /,$data->{mergedwith}));
668 @newmergelist= sort { $a <=> $b } @newmergelist;
669 $action= "Merged @newmergelist.";
670 delete @fixed{keys %found};
671 for $ref (@newmergelist) {
672 &getbug || die "huh ? $gBug $ref disappeared during merge";
673 &addmaintainers($data);
674 @bug_affected{@newmergelist} = 1 x @newmergelist;
675 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
676 $data->{keywords}= join(' ', keys %tags);
677 $data->{found_versions}= [sort keys %found];
678 $data->{fixed_versions}= [sort keys %fixed];
681 &transcript("$action\n\n");
684 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
688 @newclonedids = split /\s+/, $2;
689 $newbugsneeded = scalar(@newclonedids);
692 $bug_affected{$ref} = 1;
694 if (length($data->{mergedwith})) {
695 &transcript("$gBug is marked as being merged with others.\n\n");
698 &filelock("nextnumber.lock");
699 open(N,"nextnumber") || &quit("nextnumber: read: $!");
700 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
701 $firstref= $v+0; $v += $newbugsneeded;
702 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
705 $lastref = $firstref + $newbugsneeded - 1;
707 if ($newbugsneeded == 1) {
708 $action= "$gBug $origref cloned as bug $firstref.";
710 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
713 my $ohash = get_hashname($origref);
715 @bug_affected{@newclonedids} = 1 x @newclonedids;
716 for $newclonedid (@newclonedids) {
717 $clonebugs{$newclonedid} = $ref;
719 my $hash = get_hashname($ref);
720 copy("db-h/$ohash/$origref.log", "db-h/$hash/$ref.log");
721 copy("db-h/$ohash/$origref.status", "db-h/$hash/$ref.status");
722 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$ref.summary");
723 copy("db-h/$ohash/$origref.report", "db-h/$hash/$ref.report");
724 &bughook('new', $ref, $data);
730 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
732 my @pkgs = split /\s+/, $1;
733 if (scalar(@pkgs) > 0) {
734 %limit_pkgs = map { ($_, 1) } @pkgs;
735 &transcript("Ignoring bugs not assigned to: " .
736 join(" ", keys(%limit_pkgs)) . "\n\n");
739 &transcript("Not ignoring any bugs.\n\n");
741 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
742 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
745 $bug_affected{$ref} = 1;
747 if (length $data->{owner}) {
748 $action = "Owner changed from $data->{owner} to $newowner.";
750 $action = "Owner recorded as $newowner.";
752 if (length $data->{done}) {
753 $extramessage = "(By the way, this $gBug is currently " .
754 "marked as done.)\n";
757 &addmaintainers($data);
758 $data->{owner} = $newowner;
759 } while (&getnextbug);
761 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
764 $bug_affected{$ref} = 1;
766 if (length $data->{owner}) {
767 $action = "Removed annotation that $gBug was owned by " .
770 &addmaintainers($data);
772 } while (&getnextbug);
774 &transcript("$gBug is not marked as having an owner.\n\n");
779 &transcript("Unknown command or malformed arguments to command.\n\n");
780 if (++$unknowns >= 5) {
781 &transcript("Too many unknown commands, stopping here.\n\n");
786 if ($procline>$#bodylines) {
787 &transcript(">\nEnd of message, stopping processing here.\n\n");
789 if (!$ok && !quickabort) {
790 &transcript("No commands successfully parsed; sending the help text(s).\n");
795 &transcript("MC\n") if $dl>1;
797 for $maint (keys %maintccreasons) {
798 &transcript("MM|$maint|\n") if $dl>1;
799 next if $maint eq $replyto;
801 $reasonsref= $maintccreasons{$maint};
802 &transcript("MY|$maint|\n") if $dl>2;
803 for $p (sort keys %$reasonsref) {
804 &transcript("MP|$p|\n") if $dl>2;
805 $reasonstring.= ', ' if length($reasonstring);
806 $reasonstring.= $p.' ' if length($p);
807 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
809 if (length($reasonstring) > 40) {
810 (substr $reasonstring, 37) = "...";
812 $reasonstring = "" if (!defined($reasonstring));
813 push(@maintccs,"$maint ($reasonstring)");
814 push(@maintccaddrs,"$maint");
819 &transcript("MC|@maintccs|\n") if $dl>2;
820 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
823 # Add Bcc's to subscribed bugs
824 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
826 if (!defined $header{'subject'} || $header{'subject'} eq "") {
827 $header{'subject'} = "your mail";
831 From: $gMaintainerEmail ($gProject $gBug Tracking System)
833 ${maintccs}Subject: Processed: $header{'subject'}
834 In-Reply-To: $header{'message-id'}
835 References: $header{'message-id'}
836 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
838 X-$gProject-PR-Message: transcript
840 ${transcript}Please contact me if you need assistance.
843 (administrator, $gProject $gBugs database)
847 $repliedshow= join(', ',$replyto,@maintccaddrs);
848 &filelock("lock/-1");
849 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
851 "\2\n$repliedshow\n\5\n$reply\n\3\n".
853 "<strong>Request received</strong> from <code>".
854 &sani($header{'from'})."</code>\n".
855 "to <code>".&sani($controlrequestaddr)."</code>\n".
857 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
858 close(AP) || &quit("open db-h/-1.log: $!");
860 utime(time,time,"db-h");
862 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
864 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
866 sub sendmailmessage {
867 local ($message,@recips) = @_;
868 $message = "X-Loop: $gMaintainerEmail\n" . $message;
869 send_mail_message(message => $message,
870 recipients => \@recips,
876 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
877 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
882 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
886 local ($string,$mvarname,$svarvalue) = @_;
889 eval "\$mvarvalue= \$$mvarname";
890 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
893 "Values for \`$string' don't match:\n".
894 " #$newmergelist[0] has \`$mvarvalue';\n".
895 " #$ref has \`$svarvalue'\n"
896 if $mvarvalue ne $svarvalue;
898 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
900 eval "\$$mvarname= \$svarvalue";
905 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
906 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
912 # High-level bug manipulation calls
913 # Do announcements themselves
915 # Possible calling sequences:
919 # &transcript(something)
923 # $action= (something)
925 # (modify s_* variables)
926 # } while (getnextbug);
929 &dlen("nochangebug");
930 $state eq 'single' || $state eq 'multiple' || die "$state ?";
932 &endmerge if $manybugs;
934 &dlex("nochangebug");
938 &dlen("setbug $ref");
939 if ($ref =~ m/^-\d+/) {
940 if (!defined $clonebugs{$ref}) {
942 &dlex("setbug => noclone");
945 $ref = $clonebugs{$ref};
947 $state eq 'idle' || die "$state ?";
950 &dlex("setbug => 0s");
954 if (!&checkpkglimit) {
959 @thisbugmergelist= split(/ /,$data->{mergedwith});
960 if (!@thisbugmergelist) {
965 &dlex("setbug => 1s");
974 &dlex("setbug => 0mc");
978 $state= 'multiple'; $sref=$ref;
979 &dlex("setbug => 1m");
985 $state eq 'single' || $state eq 'multiple' || die "$state ?";
987 if (!$manybugs || !@thisbugmergelist) {
988 length($action) || die;
989 &transcript("$action\n$extramessage\n");
990 &endmerge if $manybugs;
992 &dlex("getnextbug => 0");
995 $ref= shift(@thisbugmergelist);
996 &getbug || die "bug $ref disappeared";
998 &dlex("getnextbug => 1");
1002 # Low-level bug-manipulation calls
1003 # Do no announcements
1005 # getbug (returns 0)
1007 # getbug (returns 1)
1011 # $action= (something)
1012 # getbug (returns 1)
1014 # getbug (returns 1)
1016 # [getbug (returns 0)]
1017 # &transcript("$action\n\n")
1020 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1021 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1025 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1026 &filelock('lock/merge');
1027 $mergelowstate='locked';
1033 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1035 $mergelowstate='idle';
1040 &dlen("getbug $ref");
1041 $lowstate eq 'idle' || die "$state ?";
1042 if (($data = &lockreadbug($ref))) {
1045 &dlex("getbug => 1");
1050 &dlex("getbug => 0");
1056 $lowstate eq 'open' || die "$state ?";
1063 &dlen("savebug $ref");
1064 $lowstate eq 'open' || die "$lowstate ?";
1065 length($action) || die;
1066 $ref == $sref || die "read $sref but saving $ref ?";
1067 my $hash = get_hashname($ref);
1068 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1071 "<strong>".&sani($action)."</strong>\n".
1072 "Request was from <code>".&sani($header{'from'})."</code>\n".
1073 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1075 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1076 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1077 unlockwritebug($ref, $data);
1084 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1089 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1093 print $_[0] if $debug;
1094 $transcript.= $_[0];
1101 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1102 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1118 sub sendtxthelpraw {
1119 local ($relpath,$description) = @_;
1121 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1122 while(<D>) { $doc.=$_; }
1124 &transcript("Sending $description in separate message.\n");
1125 &sendmailmessage(<<END.$doc,$replyto);
1126 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1128 Subject: $gProject $gBug help: $description
1129 References: $header{'message-id'}
1130 In-Reply-To: $header{'message-id'}
1131 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1133 X-$gProject-PR-Message: doc-text $relpath
1139 sub sendlynxdocraw {
1140 local ($relpath,$description) = @_;
1142 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1143 while(<L>) { $doc.=$_; }
1145 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1146 &transcript("Information ($description) is not available -\n".
1147 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1150 &transcript("Error getting $description (code $? $!):\n$doc\n");
1152 &transcript("Sending $description.\n");
1153 &sendmailmessage(<<END.$doc,$replyto);
1154 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1156 Subject: $gProject $gBugs information: $description
1157 References: $header{'message-id'}
1158 In-Reply-To: $header{'message-id'}
1159 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1161 X-$gProject-PR-Message: doc-html $relpath
1170 $maintccreasons{$cca}{''}{$ref}= 1;
1173 sub addmaintainers {
1174 # Data structure is:
1175 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1178 &ensuremaintainersloaded;
1179 $anymaintfound=0; $anymaintnotfound=0;
1180 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1182 $p =~ /([a-z0-9.+-]+)/;
1184 next unless defined $p;
1185 if (defined $gSubscriptionDomain) {
1186 if (defined($pkgsrc{$p})) {
1187 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1189 addbcc("$p\@$gSubscriptionDomain");
1192 if (defined $data->{severity} and defined $gStrongList and
1193 isstrongseverity($data->{severity})) {
1194 addbcc("$gStrongList\@$gListDomain");
1196 if (defined($maintainerof{$p})) {
1197 $addmaint= $maintainerof{$p};
1198 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1199 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1200 print "maintainer add >$p|$addmaint<\n" if $debug;
1202 print "maintainer none >$p<\n" if $debug;
1203 &transcript("Warning: Unknown package '$p'\n");
1204 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1205 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1209 if (length $data->{owner}) {
1210 $addmaint = $data->{owner};
1211 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1212 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1213 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1217 sub ensuremaintainersloaded {
1219 return if $maintainersloaded++;
1220 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1224 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1225 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1226 $maintainerof{$1}= $2;
1229 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1233 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1234 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1235 $maintainerof{$1}= $2;
1238 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1240 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1241 my ($a, $b) = ($1, $2);
1242 $pkgsrc{lc($a)} = $b;
1248 local ($wherefrom,$path,$description) = @_;
1249 if ($wherefrom eq "ftp.d.o") {
1250 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1252 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1253 &transcript("$description is not available.\n");
1256 &transcript("Error getting $description (code $? $!):\n$doc\n");
1259 } elsif ($wherefrom eq "local") {
1261 $doc = do { local $/; <P> };
1264 &transcript("internal errror: info files location unknown.\n");
1267 &transcript("Sending $description.\n");
1268 &sendmailmessage(<<END.$doc,$replyto);
1269 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1271 Subject: $gProject $gBugs information: $description
1272 References: $header{'message-id'}
1273 In-Reply-To: $header{'message-id'}
1274 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1276 X-$gProject-PR-Message: getinfo
1278 $description follows: