2 # $Id: service.in,v 1.113 2005/10/06 03:32:13 ajt 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 || m/^kthxbye/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/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
585 my $bugnum = $2; my $blockers = $4;
587 $addsub = "sub" if ($1 eq "un");
591 foreach my $b (split /[\s,]+/, $blockers) {
596 push @okayblockers, $b;
598 # add to the list all bugs that are merged with $b,
599 # because all of their data must be kept in sync
600 @thisbugmergelist= split(/ /,$data->{mergedwith});
603 foreach $ref (@thisbugmergelist) {
605 push @okayblockers, $ref;
612 push @badblockers, $b;
616 push @badblockers, $b;
620 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
625 if ($data->{blockedby} eq '') {
626 &transcript("Was not blocked by any bugs.\n");
628 &transcript("Was blocked by: $data->{blockedby}\n");
630 if ($addsub eq "set") {
631 $action= "Blocking bugs set to: " . join(", ", @okayblockers);
632 } elsif ($addsub eq "add") {
633 $action= "Blocking bugs added: " . join(", ", @okayblockers);
634 } elsif ($addsub eq "sub") {
635 $action= "Blocking bugs removed: " . join(", ", @okayblockers);
640 &addmaintainers($data);
641 my @oldblockerlist = split ' ', $data->{blockedby};
642 $data->{blockedby} = '' if ($addsub eq "set");
643 foreach my $b (@okayblockers) {
644 $data->{blockedby} = manipset($data->{blockedby}, $b,
648 foreach my $b (@oldblockerlist) {
649 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
650 push @{$removedblocks{$b}}, $ref;
653 foreach my $b (split ' ', $data->{blockedby}) {
654 if (! grep { $_ eq $b } @oldblockerlist) {
655 push @{$addedblocks{$b}}, $ref;
658 } while (&getnextbug);
660 # Now that the blockedby data is updated, change blocks data
661 # to match the changes.
662 foreach $ref (keys %addedblocks) {
664 foreach my $b (@{$addedblocks{$ref}}) {
665 $data->{blocks} = manipset($data->{blocks}, $b, 1);
670 foreach $ref (keys %removedblocks) {
672 foreach my $b (@{$removedblocks{$ref}}) {
673 $data->{blocks} = manipset($data->{blocks}, $b, 0);
679 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
681 $ref= $1; $newtitle= $2;
682 $bug_affected{$ref}=1;
683 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
684 $ref = $clonebugs{$ref};
687 if (&checkpkglimit) {
689 &addmaintainers($data);
690 $data->{subject}= $newtitle;
691 $action= "Changed $gBug title.";
693 &transcript("$action\n");
694 if (length($data->{done})) {
695 &transcript("(By the way, that $gBug is currently marked as done.)\n");
704 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
707 $bug_affected{$ref} = 1;
709 if (!length($data->{mergedwith})) {
710 &transcript("$gBug is not marked as being merged with any others.\n\n");
713 $mergelowstate eq 'locked' || die "$mergelowstate ?";
714 $action= "Disconnected #$ref from all other report(s).";
715 @newmergelist= split(/ /,$data->{mergedwith});
717 @bug_affected{@newmergelist} = 1 x @newmergelist;
719 &addmaintainers($data);
720 $data->{mergedwith}= ($ref == $discref) ? ''
721 : join(' ',grep($_ ne $ref,@newmergelist));
722 } while (&getnextbug);
725 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
727 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
733 while (defined($ref= shift(@tomerge))) {
734 &transcript("D| checking merge $ref\n") if $dl;
736 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
737 $ref = $clonebugs{$ref};
739 next if grep($_ eq $ref,@newmergelist);
740 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
741 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
743 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
745 &checkmatch('package','m_package',$data->{package});
746 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
747 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
748 &checkmatch('severity','m_severity',$data->{severity});
749 &checkmatch('blocks','m_blocks',$data->{blocks});
750 &checkmatch('blocked-by','m_blockedby',$data->{blockedby});
751 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
752 &checkmatch('owner','m_owner',$data->{owner});
753 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
754 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
755 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
756 if (length($mismatch)) {
757 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
759 &cancelbug; @newmergelist=(); last;
761 push(@newmergelist,$ref);
762 push(@tomerge,split(/ /,$data->{mergedwith}));
766 @newmergelist= sort { $a <=> $b } @newmergelist;
767 $action= "Merged @newmergelist.";
768 delete @fixed{keys %found};
769 for $ref (@newmergelist) {
770 &getbug || die "huh ? $gBug $ref disappeared during merge";
771 &addmaintainers($data);
772 @bug_affected{@newmergelist} = 1 x @newmergelist;
773 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
774 $data->{keywords}= join(' ', keys %tags);
775 $data->{found_versions}= [sort keys %found];
776 $data->{fixed_versions}= [sort keys %fixed];
779 &transcript("$action\n\n");
782 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
786 @newclonedids = split /\s+/, $2;
787 $newbugsneeded = scalar(@newclonedids);
790 $bug_affected{$ref} = 1;
792 if (length($data->{mergedwith})) {
793 &transcript("$gBug is marked as being merged with others.\n\n");
796 &filelock("nextnumber.lock");
797 open(N,"nextnumber") || &quit("nextnumber: read: $!");
798 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
799 $firstref= $v+0; $v += $newbugsneeded;
800 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
803 $lastref = $firstref + $newbugsneeded - 1;
805 if ($newbugsneeded == 1) {
806 $action= "$gBug $origref cloned as bug $firstref.";
808 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
811 my $blocks = $data->{blocks};
812 my $blockedby = $data->{blockedby};
815 my $ohash = get_hashname($origref);
816 my $clone = $firstref;
817 @bug_affected{@newclonedids} = 1 x @newclonedids;
818 for $newclonedid (@newclonedids) {
819 $clonebugs{$newclonedid} = $clone;
821 my $hash = get_hashname($clone);
822 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
823 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
824 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
825 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
826 &bughook('new', $clone, $data);
828 # Update blocking info of bugs blocked by or blocking the
830 foreach $ref (split ' ', $blocks) {
832 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
835 foreach $ref (split ' ', $blockedby) {
837 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
845 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
847 my @pkgs = split /\s+/, $1;
848 if (scalar(@pkgs) > 0) {
849 %limit_pkgs = map { ($_, 1) } @pkgs;
850 &transcript("Ignoring bugs not assigned to: " .
851 join(" ", keys(%limit_pkgs)) . "\n\n");
854 &transcript("Not ignoring any bugs.\n\n");
856 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
857 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
860 $bug_affected{$ref} = 1;
862 if (length $data->{owner}) {
863 $action = "Owner changed from $data->{owner} to $newowner.";
865 $action = "Owner recorded as $newowner.";
867 if (length $data->{done}) {
868 $extramessage = "(By the way, this $gBug is currently " .
869 "marked as done.)\n";
872 &addmaintainers($data);
873 $data->{owner} = $newowner;
874 } while (&getnextbug);
876 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
879 $bug_affected{$ref} = 1;
881 if (length $data->{owner}) {
882 $action = "Removed annotation that $gBug was owned by " .
885 &addmaintainers($data);
887 } while (&getnextbug);
889 &transcript("$gBug is not marked as having an owner.\n\n");
894 &transcript("Unknown command or malformed arguments to command.\n\n");
895 if (++$unknowns >= 5) {
896 &transcript("Too many unknown commands, stopping here.\n\n");
901 if ($procline>$#bodylines) {
902 &transcript(">\nEnd of message, stopping processing here.\n\n");
904 if (!$ok && !quickabort) {
905 &transcript("No commands successfully parsed; sending the help text(s).\n");
910 &transcript("MC\n") if $dl>1;
912 for $maint (keys %maintccreasons) {
913 &transcript("MM|$maint|\n") if $dl>1;
914 next if $maint eq $replyto;
916 $reasonsref= $maintccreasons{$maint};
917 &transcript("MY|$maint|\n") if $dl>2;
918 for $p (sort keys %$reasonsref) {
919 &transcript("MP|$p|\n") if $dl>2;
920 $reasonstring.= ', ' if length($reasonstring);
921 $reasonstring.= $p.' ' if length($p);
922 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
924 if (length($reasonstring) > 40) {
925 (substr $reasonstring, 37) = "...";
927 $reasonstring = "" if (!defined($reasonstring));
928 push(@maintccs,"$maint ($reasonstring)");
929 push(@maintccaddrs,"$maint");
934 &transcript("MC|@maintccs|\n") if $dl>2;
935 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
938 # Add Bcc's to subscribed bugs
939 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
941 if (!defined $header{'subject'} || $header{'subject'} eq "") {
942 $header{'subject'} = "your mail";
946 From: $gMaintainerEmail ($gProject $gBug Tracking System)
948 ${maintccs}Subject: Processed: $header{'subject'}
949 In-Reply-To: $header{'message-id'}
950 References: $header{'message-id'}
951 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
953 X-$gProject-PR-Message: transcript
955 ${transcript}Please contact me if you need assistance.
958 (administrator, $gProject $gBugs database)
962 $repliedshow= join(', ',$replyto,@maintccaddrs);
963 &filelock("lock/-1");
964 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
966 "\2\n$repliedshow\n\5\n$reply\n\3\n".
968 "<strong>Request received</strong> from <code>".
969 &sani($header{'from'})."</code>\n".
970 "to <code>".&sani($controlrequestaddr)."</code>\n".
972 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
973 close(AP) || &quit("open db-h/-1.log: $!");
975 utime(time,time,"db-h");
977 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
979 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
981 sub sendmailmessage {
982 local ($message,@recips) = @_;
983 $message = "X-Loop: $gMaintainerEmail\n" . $message;
984 send_mail_message(message => $message,
985 recipients => \@recips,
991 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
992 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
997 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1001 local ($string,$mvarname,$svarvalue) = @_;
1003 if (@newmergelist) {
1004 eval "\$mvarvalue= \$$mvarname";
1005 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1008 "Values for \`$string' don't match:\n".
1009 " #$newmergelist[0] has \`$mvarvalue';\n".
1010 " #$ref has \`$svarvalue'\n"
1011 if $mvarvalue ne $svarvalue;
1013 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1015 eval "\$$mvarname= \$svarvalue";
1020 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1021 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1032 my %h = map { $_ => 1 } split ' ', $list;
1039 return join ' ', sort keys %h;
1042 # High-level bug manipulation calls
1043 # Do announcements themselves
1045 # Possible calling sequences:
1046 # setbug (returns 0)
1048 # setbug (returns 1)
1049 # &transcript(something)
1052 # setbug (returns 1)
1053 # $action= (something)
1055 # (modify s_* variables)
1056 # } while (getnextbug);
1059 &dlen("nochangebug");
1060 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1062 &endmerge if $manybugs;
1064 &dlex("nochangebug");
1068 &dlen("setbug $ref");
1069 if ($ref =~ m/^-\d+/) {
1070 if (!defined $clonebugs{$ref}) {
1072 &dlex("setbug => noclone");
1075 $ref = $clonebugs{$ref};
1077 $state eq 'idle' || die "$state ?";
1080 &dlex("setbug => 0s");
1084 if (!&checkpkglimit) {
1089 @thisbugmergelist= split(/ /,$data->{mergedwith});
1090 if (!@thisbugmergelist) {
1095 &dlex("setbug => 1s");
1104 &dlex("setbug => 0mc");
1108 $state= 'multiple'; $sref=$ref;
1109 &dlex("setbug => 1m");
1114 &dlen("getnextbug");
1115 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1117 if (!$manybugs || !@thisbugmergelist) {
1118 length($action) || die;
1119 &transcript("$action\n$extramessage\n");
1120 &endmerge if $manybugs;
1122 &dlex("getnextbug => 0");
1125 $ref= shift(@thisbugmergelist);
1126 &getbug || die "bug $ref disappeared";
1128 &dlex("getnextbug => 1");
1132 # Low-level bug-manipulation calls
1133 # Do no announcements
1135 # getbug (returns 0)
1137 # getbug (returns 1)
1141 # $action= (something)
1142 # getbug (returns 1)
1144 # getbug (returns 1)
1146 # [getbug (returns 0)]
1147 # &transcript("$action\n\n")
1150 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1151 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1155 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1156 &filelock('lock/merge');
1157 $mergelowstate='locked';
1163 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1165 $mergelowstate='idle';
1170 &dlen("getbug $ref");
1171 $lowstate eq 'idle' || die "$state ?";
1172 if (($data = &lockreadbug($ref))) {
1175 &dlex("getbug => 1");
1180 &dlex("getbug => 0");
1186 $lowstate eq 'open' || die "$state ?";
1193 &dlen("savebug $ref");
1194 $lowstate eq 'open' || die "$lowstate ?";
1195 length($action) || die;
1196 $ref == $sref || die "read $sref but saving $ref ?";
1197 my $hash = get_hashname($ref);
1198 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1201 "<strong>".&sani($action)."</strong>\n".
1202 "Request was from <code>".&sani($header{'from'})."</code>\n".
1203 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1205 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1206 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1207 unlockwritebug($ref, $data);
1214 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1219 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1223 print $_[0] if $debug;
1224 $transcript.= $_[0];
1231 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1232 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1248 sub sendtxthelpraw {
1249 local ($relpath,$description) = @_;
1251 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1252 while(<D>) { $doc.=$_; }
1254 &transcript("Sending $description in separate message.\n");
1255 &sendmailmessage(<<END.$doc,$replyto);
1256 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1258 Subject: $gProject $gBug help: $description
1259 References: $header{'message-id'}
1260 In-Reply-To: $header{'message-id'}
1261 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1263 X-$gProject-PR-Message: doc-text $relpath
1269 sub sendlynxdocraw {
1270 local ($relpath,$description) = @_;
1272 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1273 while(<L>) { $doc.=$_; }
1275 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1276 &transcript("Information ($description) is not available -\n".
1277 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1280 &transcript("Error getting $description (code $? $!):\n$doc\n");
1282 &transcript("Sending $description.\n");
1283 &sendmailmessage(<<END.$doc,$replyto);
1284 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1286 Subject: $gProject $gBugs information: $description
1287 References: $header{'message-id'}
1288 In-Reply-To: $header{'message-id'}
1289 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1291 X-$gProject-PR-Message: doc-html $relpath
1300 $maintccreasons{$cca}{''}{$ref}= 1;
1303 sub addmaintainers {
1304 # Data structure is:
1305 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1308 &ensuremaintainersloaded;
1309 $anymaintfound=0; $anymaintnotfound=0;
1310 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1312 $p =~ /([a-z0-9.+-]+)/;
1314 next unless defined $p;
1315 if (defined $gSubscriptionDomain) {
1316 if (defined($pkgsrc{$p})) {
1317 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1319 addbcc("$p\@$gSubscriptionDomain");
1322 if (defined $data->{severity} and defined $gStrongList and
1323 isstrongseverity($data->{severity})) {
1324 addbcc("$gStrongList\@$gListDomain");
1326 if (defined($maintainerof{$p})) {
1327 $addmaint= $maintainerof{$p};
1328 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1329 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1330 print "maintainer add >$p|$addmaint<\n" if $debug;
1332 print "maintainer none >$p<\n" if $debug;
1333 &transcript("Warning: Unknown package '$p'\n");
1334 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1335 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1339 if (length $data->{owner}) {
1340 $addmaint = $data->{owner};
1341 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1342 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1343 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1347 sub ensuremaintainersloaded {
1349 return if $maintainersloaded++;
1350 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1354 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1355 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1356 $maintainerof{$1}= $2;
1359 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1363 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1364 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1365 $maintainerof{$1}= $2;
1368 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1370 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1371 my ($a, $b) = ($1, $2);
1372 $pkgsrc{lc($a)} = $b;
1378 local ($wherefrom,$path,$description) = @_;
1379 if ($wherefrom eq "ftp.d.o") {
1380 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1382 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1383 &transcript("$description is not available.\n");
1386 &transcript("Error getting $description (code $? $!):\n$doc\n");
1389 } elsif ($wherefrom eq "local") {
1391 $doc = do { local $/; <P> };
1394 &transcript("internal errror: info files location unknown.\n");
1397 &transcript("Sending $description.\n");
1398 &sendmailmessage(<<END.$doc,$replyto);
1399 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1401 Subject: $gProject $gBugs information: $description
1402 References: $header{'message-id'}
1403 In-Reply-To: $header{'message-id'}
1404 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1406 X-$gProject-PR-Message: getinfo
1408 $description follows: