2 # $Id: service.in,v 1.116 2005/10/09 14:03:32 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);
13 $config_path = '/etc/debbugs';
14 $lib_path = '/usr/lib/debbugs';
16 require "$config_path/config";
17 require "$lib_path/errorlib";
18 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
20 chdir("$gSpoolDir") || die "chdir spool: $!\n";
23 open DEBUG, ">/dev/null";
28 m/^[RC]\.\d+$/ || &quit("bad argument");
31 if (!rename("incoming/G$nn","incoming/P$nn")) {
32 $_=$!.''; m/no such file or directory/i && exit 0;
33 &quit("renaming to lock: $!");
36 open(M,"incoming/P$nn");
43 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
45 my $parser = new MIME::Parser;
46 mkdir "$gSpoolDir/mime.tmp", 0777;
47 $parser->output_under("$gSpoolDir/mime.tmp");
48 my $entity = eval { $parser->parse_data(join('',@log)) };
50 # header and decoded body respectively
51 my (@headerlines, @bodylines);
52 # Bug numbers to send e-mail to, hash so that we don't send to the
56 if ($entity and $entity->head->tags) {
57 @headerlines = @{$entity->head->header};
60 my $entity_body = getmailbody($entity);
61 @bodylines = $entity_body ? $entity_body->as_lines() : ();
64 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
66 for ($i = 0; $i <= $#msg; $i++) {
68 last unless length($_);
69 while ($msg[$i+1] =~ m/^\s/) {
73 push @headerlines, $_;
76 @bodylines = @msg[$i..$#msg];
80 $_ = decode_rfc1522($_);
82 print ">$_<\n" if $debug;
85 print ">$v=$_<\n" if $debug;
88 print "!>$_<\n" if $debug;
92 # Strip off RFC2440-style PGP clearsigning.
93 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
94 shift @bodylines while @bodylines and length $bodylines[0];
95 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
96 for my $findsig (0 .. $#bodylines) {
97 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
98 $#bodylines = $findsig - 1;
102 map { s/^- // } @bodylines;
105 grep(s/\s+$//,@bodylines);
107 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
109 if (defined $header{'resent-from'} && !defined $header{'from'}) {
110 $header{'from'} = $header{'resent-from'};
113 defined($header{'from'}) || &quit("no From header");
115 delete $header{'reply-to'}
116 if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
118 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
119 $replyto = $header{'reply-to'};
121 $replyto = $header{'from'};
124 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
126 &transcript("Processing commands for $controlrequestaddr:\n\n");
131 $mergelowstate= 'idle';
137 $user =~ s/^.*<(.*)>.*$/$1/;
138 $user =~ s/[(].*[)]//;
139 $user =~ s/^\s*(\S+)\s+.*$/$1/;
140 $user = "" unless (Debbugs::User::is_valid_user($user));
144 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
145 if (@gFuckheads and $replyto =~ m/$fuckheads/) {
146 &transcript("This service is unavailable.\n\n");
155 push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
158 for ($procline=0; $procline<=$#bodylines; $procline++) {
159 $state eq 'idle' || print "$state ?\n";
160 $lowstate eq 'idle' || print "$lowstate ?\n";
161 $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
163 &transcript("Stopping processing here.\n\n");
166 $_= $bodylines[$procline]; s/\s+$//;
168 &transcript("> $_\n");
171 if (m/^stop/i || m/^quit/i || m/^--/ || m/^thank/i || m/^kthxbye/i) {
172 &transcript("Stopping processing here.\n\n");
174 } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
176 &transcript("Debug level $dl.\n\n");
177 } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
179 &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
180 } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
182 &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
183 "detailed logs for $gBug#$ref");
184 } elsif (m/^index(\s+full)?$/i) {
185 &transcript("This BTS function is currently disabled, sorry.\n\n");
186 $ok++; # well, it's not really ok, but it fixes #81224 :)
187 } elsif (m/^index-summary\s+by-package$/i) {
188 &transcript("This BTS function is currently disabled, sorry.\n\n");
189 $ok++; # well, it's not really ok, but it fixes #81224 :)
190 } elsif (m/^index-summary(\s+by-number)?$/i) {
191 &transcript("This BTS function is currently disabled, sorry.\n\n");
192 $ok++; # well, it's not really ok, but it fixes #81224 :)
193 } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
194 &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
195 } elsif (m/^index(\s+|-)maints?$/i) {
196 &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
197 } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
199 &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
200 "$gBug list for maintainer \`$maint'");
202 } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
204 &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
205 "$gBug list for package $package");
207 } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
208 &transcript("This BTS function is currently disabled, sorry.\n\n");
209 $ok++; # well, it's not really ok, but it fixes #81224 :)
210 } elsif (m/^send-unmatched\s+(last|-1)$/i) {
211 &transcript("This BTS function is currently disabled, sorry.\n\n");
212 $ok++; # well, it's not really ok, but it fixes #81224 :)
213 } elsif (m/^send-unmatched\s+(old|-2)$/i) {
214 &transcript("This BTS function is currently disabled, sorry.\n\n");
215 $ok++; # well, it's not really ok, but it fixes #81224 :)
216 } elsif (m/^getinfo\s+([\w-.]+)$/i) {
217 # the following is basically a Debian-specific kludge, but who cares
219 if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
220 &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
221 } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
223 &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
224 } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
225 &sendinfo("local", "$gConfigDir/$req", "$req file");
227 &transcript("Info file $req does not exist.\n\n");
229 } elsif (m/^help/i) {
233 } elsif (m/^refcard/i) {
234 &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
235 } elsif (m/^subscribe/i) {
237 There is no $gProject $gBug mailing list. If you wish to review bug reports
238 please do so via http://$gWebDomain/ or ask this mail server
240 soon: MAILINGLISTS_TEXT
242 } elsif (m/^unsubscribe/i) {
244 soon: UNSUBSCRIBE_TEXT
245 soon: MAILINGLISTS_TEXT
247 } elsif (m/^user\s+(\S+)\s*$/i) {
249 if (Debbugs::User::is_valid_user($newuser)) {
250 my $olduser = ($user ne "" ? " (was $user)" : "");
251 &transcript("Setting user to $newuser$olduser.\n");
254 &transcript("Selected user id ($newuser) invalid, sorry\n");
257 } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
259 $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
261 &transcript("No valid user selected\n");
264 Debbugs::User::read_usertags(\%ut, $user);
265 my @oldtags = (); my @newtags = (); my @badtags = ();
267 for my $t (split /[,\s]+/, $tags) {
268 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
275 &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
277 for my $t (keys %chtags) {
278 $ut{$t} = [] unless defined $ut{$t};
280 for my $t (keys %ut) {
281 my %res = map { ($_, 1) } @{$ut{$t}};
282 push @oldtags, $t if defined $res{$ref};
283 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
284 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
285 : $addsubcode eq "=");
286 $res{$ref} = 1 if ($addop && defined $chtags{$t});
287 delete $res{$ref} if ($del);
288 push @newtags, $t if defined $res{$ref};
289 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
292 &transcript("There were no usertags set.\n");
294 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
296 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
297 Debbugs::User::write_usertags(\%ut, $user);
299 } elsif (!$control) {
301 Unknown command or malformed arguments to command.
302 (Use control\@$gEmailDomain to manipulate reports.)
305 if (++$unknowns >= 3) {
306 &transcript("Too many unknown commands, stopping here.\n\n");
309 #### "developer only" ones start here
310 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
313 $bug_affected{$ref}=1;
316 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
317 if (length($data->{done}) and not defined($version)) {
318 &transcript("$gBug is already closed, cannot re-close.\n\n");
323 "marked as fixed in version $version" :
325 ", send any further explanations to $data->{originator}";
327 &addmaintainers($data);
328 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
329 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
330 $data->{done}= $replyto;
331 my @keywords= split ' ', $data->{keywords};
332 if (grep $_ eq 'pending', @keywords) {
333 $extramessage= "Removed pending tag.\n";
334 $data->{keywords}= join ' ', grep $_ ne 'pending',
337 addfixedversions($data, $data->{package}, $version, 'binary');
340 From: $gMaintainerEmail ($gProject $gBug Tracking System)
341 To: $data->{originator}
342 Subject: $gBug#$ref acknowledged by developer
344 References: $header{'message-id'} $data->{msgid}
345 In-Reply-To: $data->{msgid}
346 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
347 Reply-To: $ref\@$gEmailDomain
348 X-$gProject-PR-Message: they-closed-control $ref
350 This is an automatic notification regarding your $gBug report
351 #$ref: $data->{subject},
352 which was filed against the $data->{package} package.
354 It has been marked as closed by one of the developers, namely
357 You should be hearing from them with a substantive response shortly,
358 in case you haven't already. If not, please contact them directly.
361 (administrator, $gProject $gBugs database)
364 &sendmailmessage($message,$data->{originator});
365 } while (&getnextbug);
368 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
370 $ref= $1; $newpackage= $2;
371 $bug_affected{$ref}=1;
373 $newpackage =~ y/A-Z/a-z/;
375 if (length($data->{package})) {
376 $action= "$gBug reassigned from package \`$data->{package}'".
377 " to \`$newpackage'.";
379 $action= "$gBug assigned to package \`$newpackage'.";
382 &addmaintainers($data);
383 $data->{package}= $newpackage;
384 $data->{found_versions}= [];
385 $data->{fixed_versions}= [];
386 # TODO: what if $newpackage is a source package?
387 addfoundversions($data, $data->{package}, $version, 'binary');
388 &addmaintainers($data);
389 } while (&getnextbug);
391 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
392 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
393 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
394 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
397 $bug_affected{$ref}=1;
399 if (@{$data->{fixed_versions}}) {
400 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
402 if (!length($data->{done})) {
403 &transcript("$gBug is already open, cannot reopen.\n\n");
407 $noriginator eq '' ? "$gBug reopened, originator not changed." :
408 "$gBug reopened, originator set to $noriginator.";
410 &addmaintainers($data);
411 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
412 $data->{fixed_versions}= [];
414 } while (&getnextbug);
417 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
422 if (!length($data->{done}) and not defined($version)) {
423 &transcript("$gBug is already open, cannot reopen.\n\n");
428 "$gBug marked as found in version $version." :
431 &addmaintainers($data);
432 # The 'done' field gets a bit weird with version
433 # tracking, because a bug may be closed by multiple
434 # people in different branches. Until we have something
435 # more flexible, we set it every time a bug is fixed,
436 # and clear it precisely when a found command is
437 # received for the rightmost fixed-in version, which
438 # equates to the most recent fixing of the bug, or when
439 # a versionless found command is received.
440 if (defined $version) {
442 (reverse @{$data->{fixed_versions}})[0];
443 # TODO: what if $data->{package} is a source package?
444 addfoundversions($data, $data->{package}, $version, 'binary');
445 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
449 # Versionless found; assume old-style "not fixed at
451 $data->{fixed_versions} = [];
454 } while (&getnextbug);
457 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
462 $action= "$gBug marked as not found in version $version.";
463 if (length($data->{done})) {
464 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
467 &addmaintainers($data);
468 removefoundversions($data, $data->{package}, $version, 'binary');
469 } while (&getnextbug);
471 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
472 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
475 $bug_affected{$ref}=1;
476 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
477 $ref = $clonebugs{$ref};
480 if (&checkpkglimit) {
482 &addmaintainers($data);
483 $oldsubmitter= $data->{originator};
484 $data->{originator}= $newsubmitter;
485 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
487 &transcript("$action\n");
488 if (length($data->{done})) {
489 &transcript("(By the way, that $gBug is currently marked as done.)\n");
493 From: $gMaintainerEmail ($gProject $gBug Tracking System)
495 Subject: $gBug#$ref submitter address changed
497 References: $header{'message-id'} $data->{msgid}
498 In-Reply-To: $data->{msgid}
499 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
500 Reply-To: $ref\@$gEmailDomain
501 X-$gProject-PR-Message: submitter-changed $ref
503 The submitter address recorded for your $gBug report
504 #$ref: $data->{subject}
507 The old submitter address for this report was
509 The new submitter address is
512 This change was made by
514 If it was incorrect, please contact them directly.
517 (administrator, $gProject $gBugs database)
520 &sendmailmessage($message,$oldsubmitter);
527 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
529 $ref= $1; $whereto= $2;
530 $bug_affected{$ref}=1;
532 if (length($data->{forwarded})) {
533 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
535 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
537 if (length($data->{done})) {
538 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
541 &addmaintainers($data);
542 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
543 &addccaddress("$gForwardList\@$gListDomain");
545 $data->{forwarded}= $whereto;
546 } while (&getnextbug);
548 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
551 $bug_affected{$ref}=1;
553 if (!length($data->{forwarded})) {
554 &transcript("$gBug is not marked as having been forwarded.\n\n");
557 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
559 &addmaintainers($data);
560 $data->{forwarded}= '';
561 } while (&getnextbug);
564 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
565 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
568 $bug_affected{$ref}=1;
570 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
571 &transcript("Severity level \`$newseverity' is not known.\n".
572 "Recognized are: $gShowSeverities.\n\n");
573 } elsif (exists $gObsoleteSeverities{$newseverity}) {
574 &transcript("Severity level \`$newseverity' is obsolete. " .
575 "$gObsoleteSeverities{$newseverity}\n\n");
577 $printseverity= $data->{severity};
578 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
579 $action= "Severity set to \`$newseverity' from \`$printseverity'";
581 &addmaintainers($data);
582 if (defined $gStrongList and isstrongseverity($newseverity)) {
583 addbcc("$gStrongList\@$gListDomain");
585 $data->{severity}= $newseverity;
586 } while (&getnextbug);
588 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
590 $ref = $1; $addsubcode = $3; $tags = $4;
591 $bug_affected{$ref}=1;
593 if (defined $addsubcode) {
594 $addsub = "sub" if ($addsubcode eq "-");
595 $addsub = "add" if ($addsubcode eq "+");
596 $addsub = "set" if ($addsubcode eq "=");
600 foreach my $t (split /[\s,]+/, $tags) {
601 if (!grep($_ eq $t, @gTags)) {
608 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
609 "Recognized are: ".join(' ', @gTags).".\n\n");
612 if ($data->{keywords} eq '') {
613 &transcript("There were no tags set.\n");
615 &transcript("Tags were: $data->{keywords}\n");
617 if ($addsub eq "set") {
618 $action= "Tags set to: " . join(", ", @okaytags);
619 } elsif ($addsub eq "add") {
620 $action= "Tags added: " . join(", ", @okaytags);
621 } elsif ($addsub eq "sub") {
622 $action= "Tags removed: " . join(", ", @okaytags);
625 &addmaintainers($data);
626 $data->{keywords} = '' if ($addsub eq "set");
627 # Allow removing obsolete tags.
628 if ($addsub eq "sub") {
629 foreach my $t (@badtags) {
630 $data->{keywords} = join ' ', grep $_ ne $t,
631 split ' ', $data->{keywords};
634 # Now process all other additions and subtractions.
635 foreach my $t (@okaytags) {
636 $data->{keywords} = join ' ', grep $_ ne $t,
637 split ' ', $data->{keywords};
638 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
640 $data->{keywords} =~ s/\s*$//;
641 } while (&getnextbug);
643 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
645 my $bugnum = $2; my $blockers = $4;
647 $addsub = "sub" if ($1 eq "un");
651 foreach my $b (split /[\s,]+/, $blockers) {
656 push @okayblockers, $b;
658 # add to the list all bugs that are merged with $b,
659 # because all of their data must be kept in sync
660 @thisbugmergelist= split(/ /,$data->{mergedwith});
663 foreach $ref (@thisbugmergelist) {
665 push @okayblockers, $ref;
672 push @badblockers, $b;
676 push @badblockers, $b;
680 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
685 if ($data->{blockedby} eq '') {
686 &transcript("Was not blocked by any bugs.\n");
688 &transcript("Was blocked by: $data->{blockedby}\n");
690 if ($addsub eq "set") {
691 $action= "Blocking bugs set to: " . join(", ", @okayblockers);
692 } elsif ($addsub eq "add") {
693 $action= "Blocking bugs added: " . join(", ", @okayblockers);
694 } elsif ($addsub eq "sub") {
695 $action= "Blocking bugs removed: " . join(", ", @okayblockers);
700 &addmaintainers($data);
701 my @oldblockerlist = split ' ', $data->{blockedby};
702 $data->{blockedby} = '' if ($addsub eq "set");
703 foreach my $b (@okayblockers) {
704 $data->{blockedby} = manipset($data->{blockedby}, $b,
708 foreach my $b (@oldblockerlist) {
709 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
710 push @{$removedblocks{$b}}, $ref;
713 foreach my $b (split ' ', $data->{blockedby}) {
714 if (! grep { $_ eq $b } @oldblockerlist) {
715 push @{$addedblocks{$b}}, $ref;
718 } while (&getnextbug);
720 # Now that the blockedby data is updated, change blocks data
721 # to match the changes.
722 foreach $ref (keys %addedblocks) {
724 foreach my $b (@{$addedblocks{$ref}}) {
725 $data->{blocks} = manipset($data->{blocks}, $b, 1);
730 foreach $ref (keys %removedblocks) {
732 foreach my $b (@{$removedblocks{$ref}}) {
733 $data->{blocks} = manipset($data->{blocks}, $b, 0);
739 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
741 $ref= $1; $newtitle= $2;
742 $bug_affected{$ref}=1;
743 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
744 $ref = $clonebugs{$ref};
747 if (&checkpkglimit) {
749 &addmaintainers($data);
750 $data->{subject}= $newtitle;
751 $action= "Changed $gBug title.";
753 &transcript("$action\n");
754 if (length($data->{done})) {
755 &transcript("(By the way, that $gBug is currently marked as done.)\n");
764 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
767 $bug_affected{$ref} = 1;
769 if (!length($data->{mergedwith})) {
770 &transcript("$gBug is not marked as being merged with any others.\n\n");
773 $mergelowstate eq 'locked' || die "$mergelowstate ?";
774 $action= "Disconnected #$ref from all other report(s).";
775 @newmergelist= split(/ /,$data->{mergedwith});
777 @bug_affected{@newmergelist} = 1 x @newmergelist;
779 &addmaintainers($data);
780 $data->{mergedwith}= ($ref == $discref) ? ''
781 : join(' ',grep($_ ne $ref,@newmergelist));
782 } while (&getnextbug);
785 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
787 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
793 while (defined($ref= shift(@tomerge))) {
794 &transcript("D| checking merge $ref\n") if $dl;
796 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
797 $ref = $clonebugs{$ref};
799 next if grep($_ eq $ref,@newmergelist);
800 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
801 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
803 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
805 &checkmatch('package','m_package',$data->{package});
806 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
807 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
808 &checkmatch('severity','m_severity',$data->{severity});
809 &checkmatch('blocks','m_blocks',$data->{blocks});
810 &checkmatch('blocked-by','m_blockedby',$data->{blockedby});
811 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
812 &checkmatch('owner','m_owner',$data->{owner});
813 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
814 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
815 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
816 if (length($mismatch)) {
817 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
819 &cancelbug; @newmergelist=(); last;
821 push(@newmergelist,$ref);
822 push(@tomerge,split(/ /,$data->{mergedwith}));
826 @newmergelist= sort { $a <=> $b } @newmergelist;
827 $action= "Merged @newmergelist.";
828 delete @fixed{keys %found};
829 for $ref (@newmergelist) {
830 &getbug || die "huh ? $gBug $ref disappeared during merge";
831 &addmaintainers($data);
832 @bug_affected{@newmergelist} = 1 x @newmergelist;
833 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
834 $data->{keywords}= join(' ', keys %tags);
835 $data->{found_versions}= [sort keys %found];
836 $data->{fixed_versions}= [sort keys %fixed];
839 &transcript("$action\n\n");
842 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
846 @newclonedids = split /\s+/, $2;
847 $newbugsneeded = scalar(@newclonedids);
850 $bug_affected{$ref} = 1;
852 if (length($data->{mergedwith})) {
853 &transcript("$gBug is marked as being merged with others.\n\n");
856 &filelock("nextnumber.lock");
857 open(N,"nextnumber") || &quit("nextnumber: read: $!");
858 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
859 $firstref= $v+0; $v += $newbugsneeded;
860 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
863 $lastref = $firstref + $newbugsneeded - 1;
865 if ($newbugsneeded == 1) {
866 $action= "$gBug $origref cloned as bug $firstref.";
868 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
871 my $blocks = $data->{blocks};
872 my $blockedby = $data->{blockedby};
875 my $ohash = get_hashname($origref);
876 my $clone = $firstref;
877 @bug_affected{@newclonedids} = 1 x @newclonedids;
878 for $newclonedid (@newclonedids) {
879 $clonebugs{$newclonedid} = $clone;
881 my $hash = get_hashname($clone);
882 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
883 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
884 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
885 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
886 &bughook('new', $clone, $data);
888 # Update blocking info of bugs blocked by or blocking the
890 foreach $ref (split ' ', $blocks) {
892 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
895 foreach $ref (split ' ', $blockedby) {
897 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
905 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
907 my @pkgs = split /\s+/, $1;
908 if (scalar(@pkgs) > 0) {
909 %limit_pkgs = map { ($_, 1) } @pkgs;
910 &transcript("Ignoring bugs not assigned to: " .
911 join(" ", keys(%limit_pkgs)) . "\n\n");
914 &transcript("Not ignoring any bugs.\n\n");
916 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
917 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
920 $bug_affected{$ref} = 1;
922 if (length $data->{owner}) {
923 $action = "Owner changed from $data->{owner} to $newowner.";
925 $action = "Owner recorded as $newowner.";
927 if (length $data->{done}) {
928 $extramessage = "(By the way, this $gBug is currently " .
929 "marked as done.)\n";
932 &addmaintainers($data);
933 $data->{owner} = $newowner;
934 } while (&getnextbug);
936 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
939 $bug_affected{$ref} = 1;
941 if (length $data->{owner}) {
942 $action = "Removed annotation that $gBug was owned by " .
945 &addmaintainers($data);
947 } while (&getnextbug);
949 &transcript("$gBug is not marked as having an owner.\n\n");
954 &transcript("Unknown command or malformed arguments to command.\n\n");
955 if (++$unknowns >= 5) {
956 &transcript("Too many unknown commands, stopping here.\n\n");
961 if ($procline>$#bodylines) {
962 &transcript(">\nEnd of message, stopping processing here.\n\n");
964 if (!$ok && !quickabort) {
965 &transcript("No commands successfully parsed; sending the help text(s).\n");
970 &transcript("MC\n") if $dl>1;
972 for $maint (keys %maintccreasons) {
973 &transcript("MM|$maint|\n") if $dl>1;
974 next if $maint eq $replyto;
976 $reasonsref= $maintccreasons{$maint};
977 &transcript("MY|$maint|\n") if $dl>2;
978 for $p (sort keys %$reasonsref) {
979 &transcript("MP|$p|\n") if $dl>2;
980 $reasonstring.= ', ' if length($reasonstring);
981 $reasonstring.= $p.' ' if length($p);
982 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
984 if (length($reasonstring) > 40) {
985 (substr $reasonstring, 37) = "...";
987 $reasonstring = "" if (!defined($reasonstring));
988 push(@maintccs,"$maint ($reasonstring)");
989 push(@maintccaddrs,"$maint");
994 &transcript("MC|@maintccs|\n") if $dl>2;
995 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
998 # Add Bcc's to subscribed bugs
999 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1001 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1002 $header{'subject'} = "your mail";
1006 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1008 ${maintccs}Subject: Processed: $header{'subject'}
1009 In-Reply-To: $header{'message-id'}
1010 References: $header{'message-id'}
1011 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1013 X-$gProject-PR-Message: transcript
1015 ${transcript}Please contact me if you need assistance.
1018 (administrator, $gProject $gBugs database)
1022 $repliedshow= join(', ',$replyto,@maintccaddrs);
1023 &filelock("lock/-1");
1024 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1026 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1028 "<strong>Request received</strong> from <code>".
1029 &sani($header{'from'})."</code>\n".
1030 "to <code>".&sani($controlrequestaddr)."</code>\n".
1032 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1033 close(AP) || &quit("open db-h/-1.log: $!");
1035 utime(time,time,"db-h");
1037 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
1039 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1041 sub sendmailmessage {
1042 local ($message,@recips) = @_;
1043 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1044 send_mail_message(message => $message,
1045 recipients => \@recips,
1051 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1052 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1056 #sub unimplemented {
1057 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1061 local ($string,$mvarname,$svarvalue) = @_;
1063 if (@newmergelist) {
1064 eval "\$mvarvalue= \$$mvarname";
1065 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1068 "Values for \`$string' don't match:\n".
1069 " #$newmergelist[0] has \`$mvarvalue';\n".
1070 " #$ref has \`$svarvalue'\n"
1071 if $mvarvalue ne $svarvalue;
1073 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1075 eval "\$$mvarname= \$svarvalue";
1080 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1081 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1092 my %h = map { $_ => 1 } split ' ', $list;
1099 return join ' ', sort keys %h;
1102 # High-level bug manipulation calls
1103 # Do announcements themselves
1105 # Possible calling sequences:
1106 # setbug (returns 0)
1108 # setbug (returns 1)
1109 # &transcript(something)
1112 # setbug (returns 1)
1113 # $action= (something)
1115 # (modify s_* variables)
1116 # } while (getnextbug);
1119 &dlen("nochangebug");
1120 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1122 &endmerge if $manybugs;
1124 &dlex("nochangebug");
1128 &dlen("setbug $ref");
1129 if ($ref =~ m/^-\d+/) {
1130 if (!defined $clonebugs{$ref}) {
1132 &dlex("setbug => noclone");
1135 $ref = $clonebugs{$ref};
1137 $state eq 'idle' || die "$state ?";
1140 &dlex("setbug => 0s");
1144 if (!&checkpkglimit) {
1149 @thisbugmergelist= split(/ /,$data->{mergedwith});
1150 if (!@thisbugmergelist) {
1155 &dlex("setbug => 1s");
1164 &dlex("setbug => 0mc");
1168 $state= 'multiple'; $sref=$ref;
1169 &dlex("setbug => 1m");
1174 &dlen("getnextbug");
1175 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1177 if (!$manybugs || !@thisbugmergelist) {
1178 length($action) || die;
1179 &transcript("$action\n$extramessage\n");
1180 &endmerge if $manybugs;
1182 &dlex("getnextbug => 0");
1185 $ref= shift(@thisbugmergelist);
1186 &getbug || die "bug $ref disappeared";
1188 &dlex("getnextbug => 1");
1192 # Low-level bug-manipulation calls
1193 # Do no announcements
1195 # getbug (returns 0)
1197 # getbug (returns 1)
1201 # $action= (something)
1202 # getbug (returns 1)
1204 # getbug (returns 1)
1206 # [getbug (returns 0)]
1207 # &transcript("$action\n\n")
1210 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1211 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1215 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1216 &filelock('lock/merge');
1217 $mergelowstate='locked';
1223 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1225 $mergelowstate='idle';
1230 &dlen("getbug $ref");
1231 $lowstate eq 'idle' || die "$state ?";
1232 if (($data = &lockreadbug($ref))) {
1235 &dlex("getbug => 1");
1240 &dlex("getbug => 0");
1246 $lowstate eq 'open' || die "$state ?";
1253 &dlen("savebug $ref");
1254 $lowstate eq 'open' || die "$lowstate ?";
1255 length($action) || die;
1256 $ref == $sref || die "read $sref but saving $ref ?";
1257 my $hash = get_hashname($ref);
1258 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1261 "<strong>".&sani($action)."</strong>\n".
1262 "Request was from <code>".&sani($header{'from'})."</code>\n".
1263 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1265 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1266 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1267 unlockwritebug($ref, $data);
1274 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1279 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1283 print $_[0] if $debug;
1284 $transcript.= $_[0];
1291 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1292 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1308 sub sendtxthelpraw {
1309 local ($relpath,$description) = @_;
1311 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1312 while(<D>) { $doc.=$_; }
1314 &transcript("Sending $description in separate message.\n");
1315 &sendmailmessage(<<END.$doc,$replyto);
1316 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1318 Subject: $gProject $gBug help: $description
1319 References: $header{'message-id'}
1320 In-Reply-To: $header{'message-id'}
1321 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1323 X-$gProject-PR-Message: doc-text $relpath
1329 sub sendlynxdocraw {
1330 local ($relpath,$description) = @_;
1332 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1333 while(<L>) { $doc.=$_; }
1335 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1336 &transcript("Information ($description) is not available -\n".
1337 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1340 &transcript("Error getting $description (code $? $!):\n$doc\n");
1342 &transcript("Sending $description.\n");
1343 &sendmailmessage(<<END.$doc,$replyto);
1344 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1346 Subject: $gProject $gBugs information: $description
1347 References: $header{'message-id'}
1348 In-Reply-To: $header{'message-id'}
1349 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1351 X-$gProject-PR-Message: doc-html $relpath
1360 $maintccreasons{$cca}{''}{$ref}= 1;
1363 sub addmaintainers {
1364 # Data structure is:
1365 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1368 &ensuremaintainersloaded;
1369 $anymaintfound=0; $anymaintnotfound=0;
1370 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1372 $p =~ /([a-z0-9.+-]+)/;
1374 next unless defined $p;
1375 if (defined $gSubscriptionDomain) {
1376 if (defined($pkgsrc{$p})) {
1377 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1379 addbcc("$p\@$gSubscriptionDomain");
1382 if (defined $data->{severity} and defined $gStrongList and
1383 isstrongseverity($data->{severity})) {
1384 addbcc("$gStrongList\@$gListDomain");
1386 if (defined($maintainerof{$p})) {
1387 $addmaint= $maintainerof{$p};
1388 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1389 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1390 print "maintainer add >$p|$addmaint<\n" if $debug;
1392 print "maintainer none >$p<\n" if $debug;
1393 &transcript("Warning: Unknown package '$p'\n");
1394 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1395 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1399 if (length $data->{owner}) {
1400 $addmaint = $data->{owner};
1401 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1402 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1403 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1407 sub ensuremaintainersloaded {
1409 return if $maintainersloaded++;
1410 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1414 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1415 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1416 $maintainerof{$1}= $2;
1419 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1423 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1424 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1425 $maintainerof{$1}= $2;
1428 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1430 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1431 my ($a, $b) = ($1, $2);
1432 $pkgsrc{lc($a)} = $b;
1438 local ($wherefrom,$path,$description) = @_;
1439 if ($wherefrom eq "ftp.d.o") {
1440 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1442 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1443 &transcript("$description is not available.\n");
1446 &transcript("Error getting $description (code $? $!):\n$doc\n");
1449 } elsif ($wherefrom eq "local") {
1451 $doc = do { local $/; <P> };
1454 &transcript("internal errror: info files location unknown.\n");
1457 &transcript("Sending $description.\n");
1458 &sendmailmessage(<<END.$doc,$replyto);
1459 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1461 Subject: $gProject $gBugs information: $description
1462 References: $header{'message-id'}
1463 In-Reply-To: $header{'message-id'}
1464 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1466 X-$gProject-PR-Message: getinfo
1468 $description follows: