2 # $Id: service.in,v 1.114 2005/10/06 03:40: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 = ();
266 my %chtags = map { ($_, 1) } split /[,\s]+/, $tags;
267 for my $t (keys %chtags) {
268 $ut{$t} = [] unless defined $ut{$t};
270 for my $t (keys %ut) {
271 my %res = map { ($_, 1) } @{$ut{$t}};
272 push @oldtags, $t if defined $res{$ref};
273 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
274 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
275 : $addsubcode eq "=");
276 $res{$ref} = 1 if ($addop && defined $chtags{$t});
277 delete $res{$ref} if ($del);
278 push @newtags, $t if defined $res{$ref};
279 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
282 &transcript("There were no usertags set.\n");
284 &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
286 &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
287 Debbugs::User::write_usertags(\%ut, $user);
289 } elsif (!$control) {
291 Unknown command or malformed arguments to command.
292 (Use control\@$gEmailDomain to manipulate reports.)
295 if (++$unknowns >= 3) {
296 &transcript("Too many unknown commands, stopping here.\n\n");
299 #### "developer only" ones start here
300 } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
303 $bug_affected{$ref}=1;
306 &transcript("'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n");
307 if (length($data->{done}) and not defined($version)) {
308 &transcript("$gBug is already closed, cannot re-close.\n\n");
313 "marked as fixed in version $version" :
315 ", send any further explanations to $data->{originator}";
317 &addmaintainers($data);
318 if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
319 0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
320 $data->{done}= $replyto;
321 my @keywords= split ' ', $data->{keywords};
322 if (grep $_ eq 'pending', @keywords) {
323 $extramessage= "Removed pending tag.\n";
324 $data->{keywords}= join ' ', grep $_ ne 'pending',
327 addfixedversions($data, $data->{package}, $version, 'binary');
330 From: $gMaintainerEmail ($gProject $gBug Tracking System)
331 To: $data->{originator}
332 Subject: $gBug#$ref acknowledged by developer
334 References: $header{'message-id'} $data->{msgid}
335 In-Reply-To: $data->{msgid}
336 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
337 Reply-To: $ref\@$gEmailDomain
338 X-$gProject-PR-Message: they-closed-control $ref
340 This is an automatic notification regarding your $gBug report
341 #$ref: $data->{subject},
342 which was filed against the $data->{package} package.
344 It has been marked as closed by one of the developers, namely
347 You should be hearing from them with a substantive response shortly,
348 in case you haven't already. If not, please contact them directly.
351 (administrator, $gProject $gBugs database)
354 &sendmailmessage($message,$data->{originator});
355 } while (&getnextbug);
358 } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
360 $ref= $1; $newpackage= $2;
361 $bug_affected{$ref}=1;
363 $newpackage =~ y/A-Z/a-z/;
365 if (length($data->{package})) {
366 $action= "$gBug reassigned from package \`$data->{package}'".
367 " to \`$newpackage'.";
369 $action= "$gBug assigned to package \`$newpackage'.";
372 &addmaintainers($data);
373 $data->{package}= $newpackage;
374 $data->{found_versions}= [];
375 $data->{fixed_versions}= [];
376 # TODO: what if $newpackage is a source package?
377 addfoundversions($data, $data->{package}, $version, 'binary');
378 &addmaintainers($data);
379 } while (&getnextbug);
381 } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
382 m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
383 m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
384 m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
387 $bug_affected{$ref}=1;
389 if (@{$data->{fixed_versions}}) {
390 &transcript("'reopen' is deprecated when a bug has been closed with a version;\nuse 'found' or 'submitter' as appropriate instead.\n");
392 if (!length($data->{done})) {
393 &transcript("$gBug is already open, cannot reopen.\n\n");
397 $noriginator eq '' ? "$gBug reopened, originator not changed." :
398 "$gBug reopened, originator set to $noriginator.";
400 &addmaintainers($data);
401 $data->{originator}= $noriginator eq '' ? $data->{originator} : $noriginator;
402 $data->{fixed_versions}= [];
404 } while (&getnextbug);
407 } elsif (m/^found\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
412 if (!length($data->{done}) and not defined($version)) {
413 &transcript("$gBug is already open, cannot reopen.\n\n");
418 "$gBug marked as found in version $version." :
421 &addmaintainers($data);
422 # The 'done' field gets a bit weird with version
423 # tracking, because a bug may be closed by multiple
424 # people in different branches. Until we have something
425 # more flexible, we set it every time a bug is fixed,
426 # and clear it precisely when a found command is
427 # received for the rightmost fixed-in version, which
428 # equates to the most recent fixing of the bug, or when
429 # a versionless found command is received.
430 if (defined $version) {
432 (reverse @{$data->{fixed_versions}})[0];
433 # TODO: what if $data->{package} is a source package?
434 addfoundversions($data, $data->{package}, $version, 'binary');
435 if (defined $lastfixed and not grep { $_ eq $lastfixed } @{$data->{fixed_versions}}) {
439 # Versionless found; assume old-style "not fixed at
441 $data->{fixed_versions} = [];
444 } while (&getnextbug);
447 } elsif (m/^notfound\s+\#?(-?\d+)\s+(\d.*)$/i) {
452 $action= "$gBug marked as not found in version $version.";
453 if (length($data->{done})) {
454 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
457 &addmaintainers($data);
458 removefoundversions($data, $data->{package}, $version, 'binary');
459 } while (&getnextbug);
461 } elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
462 m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
465 $bug_affected{$ref}=1;
466 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
467 $ref = $clonebugs{$ref};
470 if (&checkpkglimit) {
472 &addmaintainers($data);
473 $oldsubmitter= $data->{originator};
474 $data->{originator}= $newsubmitter;
475 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
477 &transcript("$action\n");
478 if (length($data->{done})) {
479 &transcript("(By the way, that $gBug is currently marked as done.)\n");
483 From: $gMaintainerEmail ($gProject $gBug Tracking System)
485 Subject: $gBug#$ref submitter address changed
487 References: $header{'message-id'} $data->{msgid}
488 In-Reply-To: $data->{msgid}
489 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
490 Reply-To: $ref\@$gEmailDomain
491 X-$gProject-PR-Message: submitter-changed $ref
493 The submitter address recorded for your $gBug report
494 #$ref: $data->{subject}
497 The old submitter address for this report was
499 The new submitter address is
502 This change was made by
504 If it was incorrect, please contact them directly.
507 (administrator, $gProject $gBugs database)
510 &sendmailmessage($message,$oldsubmitter);
517 } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
519 $ref= $1; $whereto= $2;
520 $bug_affected{$ref}=1;
522 if (length($data->{forwarded})) {
523 $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
525 $action= "Noted your statement that $gBug has been forwarded to $whereto.";
527 if (length($data->{done})) {
528 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
531 &addmaintainers($data);
532 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
533 &addccaddress("$gForwardList\@$gListDomain");
535 $data->{forwarded}= $whereto;
536 } while (&getnextbug);
538 } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
541 $bug_affected{$ref}=1;
543 if (!length($data->{forwarded})) {
544 &transcript("$gBug is not marked as having been forwarded.\n\n");
547 $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
549 &addmaintainers($data);
550 $data->{forwarded}= '';
551 } while (&getnextbug);
554 } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
555 m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
558 $bug_affected{$ref}=1;
560 if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
561 &transcript("Severity level \`$newseverity' is not known.\n".
562 "Recognized are: $gShowSeverities.\n\n");
563 } elsif (exists $gObsoleteSeverities{$newseverity}) {
564 &transcript("Severity level \`$newseverity' is obsolete. " .
565 "$gObsoleteSeverities{$newseverity}\n\n");
567 $printseverity= $data->{severity};
568 $printseverity= "$gDefaultSeverity" if $printseverity eq '';
569 $action= "Severity set to \`$newseverity' from \`$printseverity'";
571 &addmaintainers($data);
572 if (defined $gStrongList and isstrongseverity($newseverity)) {
573 addbcc("$gStrongList\@$gListDomain");
575 $data->{severity}= $newseverity;
576 } while (&getnextbug);
578 } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
580 $ref = $1; $addsubcode = $3; $tags = $4;
581 $bug_affected{$ref}=1;
583 if (defined $addsubcode) {
584 $addsub = "sub" if ($addsubcode eq "-");
585 $addsub = "add" if ($addsubcode eq "+");
586 $addsub = "set" if ($addsubcode eq "=");
590 foreach my $t (split /[\s,]+/, $tags) {
591 if (!grep($_ eq $t, @gTags)) {
598 &transcript("Unknown tag/s: ".join(', ', @badtags).".\n".
599 "Recognized are: ".join(' ', @gTags).".\n\n");
602 if ($data->{keywords} eq '') {
603 &transcript("There were no tags set.\n");
605 &transcript("Tags were: $data->{keywords}\n");
607 if ($addsub eq "set") {
608 $action= "Tags set to: " . join(", ", @okaytags);
609 } elsif ($addsub eq "add") {
610 $action= "Tags added: " . join(", ", @okaytags);
611 } elsif ($addsub eq "sub") {
612 $action= "Tags removed: " . join(", ", @okaytags);
615 &addmaintainers($data);
616 $data->{keywords} = '' if ($addsub eq "set");
617 # Allow removing obsolete tags.
618 if ($addsub eq "sub") {
619 foreach my $t (@badtags) {
620 $data->{keywords} = join ' ', grep $_ ne $t,
621 split ' ', $data->{keywords};
624 # Now process all other additions and subtractions.
625 foreach my $t (@okaytags) {
626 $data->{keywords} = join ' ', grep $_ ne $t,
627 split ' ', $data->{keywords};
628 $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
630 $data->{keywords} =~ s/\s*$//;
631 } while (&getnextbug);
633 } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+\s*(\S.*)?$/i) {
635 my $bugnum = $2; my $blockers = $4;
637 $addsub = "sub" if ($1 eq "un");
641 foreach my $b (split /[\s,]+/, $blockers) {
646 push @okayblockers, $b;
648 # add to the list all bugs that are merged with $b,
649 # because all of their data must be kept in sync
650 @thisbugmergelist= split(/ /,$data->{mergedwith});
653 foreach $ref (@thisbugmergelist) {
655 push @okayblockers, $ref;
662 push @badblockers, $b;
666 push @badblockers, $b;
670 &transcript("Unknown blocking bug/s: ".join(', ', @badblockers).".\n");
675 if ($data->{blockedby} eq '') {
676 &transcript("Was not blocked by any bugs.\n");
678 &transcript("Was blocked by: $data->{blockedby}\n");
680 if ($addsub eq "set") {
681 $action= "Blocking bugs set to: " . join(", ", @okayblockers);
682 } elsif ($addsub eq "add") {
683 $action= "Blocking bugs added: " . join(", ", @okayblockers);
684 } elsif ($addsub eq "sub") {
685 $action= "Blocking bugs removed: " . join(", ", @okayblockers);
690 &addmaintainers($data);
691 my @oldblockerlist = split ' ', $data->{blockedby};
692 $data->{blockedby} = '' if ($addsub eq "set");
693 foreach my $b (@okayblockers) {
694 $data->{blockedby} = manipset($data->{blockedby}, $b,
698 foreach my $b (@oldblockerlist) {
699 if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
700 push @{$removedblocks{$b}}, $ref;
703 foreach my $b (split ' ', $data->{blockedby}) {
704 if (! grep { $_ eq $b } @oldblockerlist) {
705 push @{$addedblocks{$b}}, $ref;
708 } while (&getnextbug);
710 # Now that the blockedby data is updated, change blocks data
711 # to match the changes.
712 foreach $ref (keys %addedblocks) {
714 foreach my $b (@{$addedblocks{$ref}}) {
715 $data->{blocks} = manipset($data->{blocks}, $b, 1);
720 foreach $ref (keys %removedblocks) {
722 foreach my $b (@{$removedblocks{$ref}}) {
723 $data->{blocks} = manipset($data->{blocks}, $b, 0);
729 } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
731 $ref= $1; $newtitle= $2;
732 $bug_affected{$ref}=1;
733 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
734 $ref = $clonebugs{$ref};
737 if (&checkpkglimit) {
739 &addmaintainers($data);
740 $data->{subject}= $newtitle;
741 $action= "Changed $gBug title.";
743 &transcript("$action\n");
744 if (length($data->{done})) {
745 &transcript("(By the way, that $gBug is currently marked as done.)\n");
754 } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
757 $bug_affected{$ref} = 1;
759 if (!length($data->{mergedwith})) {
760 &transcript("$gBug is not marked as being merged with any others.\n\n");
763 $mergelowstate eq 'locked' || die "$mergelowstate ?";
764 $action= "Disconnected #$ref from all other report(s).";
765 @newmergelist= split(/ /,$data->{mergedwith});
767 @bug_affected{@newmergelist} = 1 x @newmergelist;
769 &addmaintainers($data);
770 $data->{mergedwith}= ($ref == $discref) ? ''
771 : join(' ',grep($_ ne $ref,@newmergelist));
772 } while (&getnextbug);
775 } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
777 @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
783 while (defined($ref= shift(@tomerge))) {
784 &transcript("D| checking merge $ref\n") if $dl;
786 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
787 $ref = $clonebugs{$ref};
789 next if grep($_ eq $ref,@newmergelist);
790 if (!&getbug) { ¬foundbug; @newmergelist=(); last }
791 if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
793 &transcript("D| adding $ref ($data->{mergedwith})\n") if $dl;
795 &checkmatch('package','m_package',$data->{package});
796 &checkmatch('forwarded addr','m_forwarded',$data->{forwarded});
797 $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
798 &checkmatch('severity','m_severity',$data->{severity});
799 &checkmatch('blocks','m_blocks',$data->{blocks});
800 &checkmatch('blocked-by','m_blockedby',$data->{blockedby});
801 &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open');
802 &checkmatch('owner','m_owner',$data->{owner});
803 foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
804 foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
805 foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
806 if (length($mismatch)) {
807 &transcript("Mismatch - only $gBugs in same state can be merged:\n".
809 &cancelbug; @newmergelist=(); last;
811 push(@newmergelist,$ref);
812 push(@tomerge,split(/ /,$data->{mergedwith}));
816 @newmergelist= sort { $a <=> $b } @newmergelist;
817 $action= "Merged @newmergelist.";
818 delete @fixed{keys %found};
819 for $ref (@newmergelist) {
820 &getbug || die "huh ? $gBug $ref disappeared during merge";
821 &addmaintainers($data);
822 @bug_affected{@newmergelist} = 1 x @newmergelist;
823 $data->{mergedwith}= join(' ',grep($_ ne $ref,@newmergelist));
824 $data->{keywords}= join(' ', keys %tags);
825 $data->{found_versions}= [sort keys %found];
826 $data->{fixed_versions}= [sort keys %fixed];
829 &transcript("$action\n\n");
832 } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
836 @newclonedids = split /\s+/, $2;
837 $newbugsneeded = scalar(@newclonedids);
840 $bug_affected{$ref} = 1;
842 if (length($data->{mergedwith})) {
843 &transcript("$gBug is marked as being merged with others.\n\n");
846 &filelock("nextnumber.lock");
847 open(N,"nextnumber") || &quit("nextnumber: read: $!");
848 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
849 $firstref= $v+0; $v += $newbugsneeded;
850 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
853 $lastref = $firstref + $newbugsneeded - 1;
855 if ($newbugsneeded == 1) {
856 $action= "$gBug $origref cloned as bug $firstref.";
858 $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
861 my $blocks = $data->{blocks};
862 my $blockedby = $data->{blockedby};
865 my $ohash = get_hashname($origref);
866 my $clone = $firstref;
867 @bug_affected{@newclonedids} = 1 x @newclonedids;
868 for $newclonedid (@newclonedids) {
869 $clonebugs{$newclonedid} = $clone;
871 my $hash = get_hashname($clone);
872 copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
873 copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
874 copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
875 copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
876 &bughook('new', $clone, $data);
878 # Update blocking info of bugs blocked by or blocking the
880 foreach $ref (split ' ', $blocks) {
882 $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
885 foreach $ref (split ' ', $blockedby) {
887 $data->{blocks} = manipset($data->{blocks}, $clone, 1);
895 } elsif (m/^package\s+(\S.*\S)?\s*$/i) {
897 my @pkgs = split /\s+/, $1;
898 if (scalar(@pkgs) > 0) {
899 %limit_pkgs = map { ($_, 1) } @pkgs;
900 &transcript("Ignoring bugs not assigned to: " .
901 join(" ", keys(%limit_pkgs)) . "\n\n");
904 &transcript("Not ignoring any bugs.\n\n");
906 } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
907 m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
910 $bug_affected{$ref} = 1;
912 if (length $data->{owner}) {
913 $action = "Owner changed from $data->{owner} to $newowner.";
915 $action = "Owner recorded as $newowner.";
917 if (length $data->{done}) {
918 $extramessage = "(By the way, this $gBug is currently " .
919 "marked as done.)\n";
922 &addmaintainers($data);
923 $data->{owner} = $newowner;
924 } while (&getnextbug);
926 } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
929 $bug_affected{$ref} = 1;
931 if (length $data->{owner}) {
932 $action = "Removed annotation that $gBug was owned by " .
935 &addmaintainers($data);
937 } while (&getnextbug);
939 &transcript("$gBug is not marked as having an owner.\n\n");
944 &transcript("Unknown command or malformed arguments to command.\n\n");
945 if (++$unknowns >= 5) {
946 &transcript("Too many unknown commands, stopping here.\n\n");
951 if ($procline>$#bodylines) {
952 &transcript(">\nEnd of message, stopping processing here.\n\n");
954 if (!$ok && !quickabort) {
955 &transcript("No commands successfully parsed; sending the help text(s).\n");
960 &transcript("MC\n") if $dl>1;
962 for $maint (keys %maintccreasons) {
963 &transcript("MM|$maint|\n") if $dl>1;
964 next if $maint eq $replyto;
966 $reasonsref= $maintccreasons{$maint};
967 &transcript("MY|$maint|\n") if $dl>2;
968 for $p (sort keys %$reasonsref) {
969 &transcript("MP|$p|\n") if $dl>2;
970 $reasonstring.= ', ' if length($reasonstring);
971 $reasonstring.= $p.' ' if length($p);
972 $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
974 if (length($reasonstring) > 40) {
975 (substr $reasonstring, 37) = "...";
977 $reasonstring = "" if (!defined($reasonstring));
978 push(@maintccs,"$maint ($reasonstring)");
979 push(@maintccaddrs,"$maint");
984 &transcript("MC|@maintccs|\n") if $dl>2;
985 $maintccs .= "Cc: " . join(",\n ",@maintccs) . "\n";
988 # Add Bcc's to subscribed bugs
989 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
991 if (!defined $header{'subject'} || $header{'subject'} eq "") {
992 $header{'subject'} = "your mail";
996 From: $gMaintainerEmail ($gProject $gBug Tracking System)
998 ${maintccs}Subject: Processed: $header{'subject'}
999 In-Reply-To: $header{'message-id'}
1000 References: $header{'message-id'}
1001 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1003 X-$gProject-PR-Message: transcript
1005 ${transcript}Please contact me if you need assistance.
1008 (administrator, $gProject $gBugs database)
1012 $repliedshow= join(', ',$replyto,@maintccaddrs);
1013 &filelock("lock/-1");
1014 open(AP,">>db-h/-1.log") || &quit("open db-h/-1.log: $!");
1016 "\2\n$repliedshow\n\5\n$reply\n\3\n".
1018 "<strong>Request received</strong> from <code>".
1019 &sani($header{'from'})."</code>\n".
1020 "to <code>".&sani($controlrequestaddr)."</code>\n".
1022 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/-1.log: $!");
1023 close(AP) || &quit("open db-h/-1.log: $!");
1025 utime(time,time,"db-h");
1027 &sendmailmessage($reply,$replyto,@maintccaddrs,@bcc);
1029 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1031 sub sendmailmessage {
1032 local ($message,@recips) = @_;
1033 $message = "X-Loop: $gMaintainerEmail\n" . $message;
1034 send_mail_message(message => $message,
1035 recipients => \@recips,
1041 &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1042 &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1046 #sub unimplemented {
1047 # &transcript("Sorry, command $_[0] not yet implemented.\n\n");
1051 local ($string,$mvarname,$svarvalue) = @_;
1053 if (@newmergelist) {
1054 eval "\$mvarvalue= \$$mvarname";
1055 &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
1058 "Values for \`$string' don't match:\n".
1059 " #$newmergelist[0] has \`$mvarvalue';\n".
1060 " #$ref has \`$svarvalue'\n"
1061 if $mvarvalue ne $svarvalue;
1063 &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
1065 eval "\$$mvarname= \$svarvalue";
1070 if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1071 &transcript("$gBug number $ref belongs to package $data->{package}, skipping.\n\n");
1082 my %h = map { $_ => 1 } split ' ', $list;
1089 return join ' ', sort keys %h;
1092 # High-level bug manipulation calls
1093 # Do announcements themselves
1095 # Possible calling sequences:
1096 # setbug (returns 0)
1098 # setbug (returns 1)
1099 # &transcript(something)
1102 # setbug (returns 1)
1103 # $action= (something)
1105 # (modify s_* variables)
1106 # } while (getnextbug);
1109 &dlen("nochangebug");
1110 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1112 &endmerge if $manybugs;
1114 &dlex("nochangebug");
1118 &dlen("setbug $ref");
1119 if ($ref =~ m/^-\d+/) {
1120 if (!defined $clonebugs{$ref}) {
1122 &dlex("setbug => noclone");
1125 $ref = $clonebugs{$ref};
1127 $state eq 'idle' || die "$state ?";
1130 &dlex("setbug => 0s");
1134 if (!&checkpkglimit) {
1139 @thisbugmergelist= split(/ /,$data->{mergedwith});
1140 if (!@thisbugmergelist) {
1145 &dlex("setbug => 1s");
1154 &dlex("setbug => 0mc");
1158 $state= 'multiple'; $sref=$ref;
1159 &dlex("setbug => 1m");
1164 &dlen("getnextbug");
1165 $state eq 'single' || $state eq 'multiple' || die "$state ?";
1167 if (!$manybugs || !@thisbugmergelist) {
1168 length($action) || die;
1169 &transcript("$action\n$extramessage\n");
1170 &endmerge if $manybugs;
1172 &dlex("getnextbug => 0");
1175 $ref= shift(@thisbugmergelist);
1176 &getbug || die "bug $ref disappeared";
1178 &dlex("getnextbug => 1");
1182 # Low-level bug-manipulation calls
1183 # Do no announcements
1185 # getbug (returns 0)
1187 # getbug (returns 1)
1191 # $action= (something)
1192 # getbug (returns 1)
1194 # getbug (returns 1)
1196 # [getbug (returns 0)]
1197 # &transcript("$action\n\n")
1200 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
1201 sub foundbug { &transcript("$gBug#$ref: $data->{subject}\n"); }
1205 $mergelowstate eq 'idle' || die "$mergelowstate ?";
1206 &filelock('lock/merge');
1207 $mergelowstate='locked';
1213 $mergelowstate eq 'locked' || die "$mergelowstate ?";
1215 $mergelowstate='idle';
1220 &dlen("getbug $ref");
1221 $lowstate eq 'idle' || die "$state ?";
1222 if (($data = &lockreadbug($ref))) {
1225 &dlex("getbug => 1");
1230 &dlex("getbug => 0");
1236 $lowstate eq 'open' || die "$state ?";
1243 &dlen("savebug $ref");
1244 $lowstate eq 'open' || die "$lowstate ?";
1245 length($action) || die;
1246 $ref == $sref || die "read $sref but saving $ref ?";
1247 my $hash = get_hashname($ref);
1248 open(L,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log: $!");
1251 "<strong>".&sani($action)."</strong>\n".
1252 "Request was from <code>".&sani($header{'from'})."</code>\n".
1253 "to <code>".&sani($controlrequestaddr)."</code>. \n".
1255 "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log: $!");
1256 close(L) || &quit("closing db-h/$hash/$ref.log: $!");
1257 unlockwritebug($ref, $data);
1264 &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
1269 &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
1273 print $_[0] if $debug;
1274 $transcript.= $_[0];
1281 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1282 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1298 sub sendtxthelpraw {
1299 local ($relpath,$description) = @_;
1301 open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
1302 while(<D>) { $doc.=$_; }
1304 &transcript("Sending $description in separate message.\n");
1305 &sendmailmessage(<<END.$doc,$replyto);
1306 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1308 Subject: $gProject $gBug help: $description
1309 References: $header{'message-id'}
1310 In-Reply-To: $header{'message-id'}
1311 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1313 X-$gProject-PR-Message: doc-text $relpath
1319 sub sendlynxdocraw {
1320 local ($relpath,$description) = @_;
1322 open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || &quit("fork for lynx: $!");
1323 while(<L>) { $doc.=$_; }
1325 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1326 &transcript("Information ($description) is not available -\n".
1327 "perhaps the $gBug does not exist or is not on the WWW yet.\n");
1330 &transcript("Error getting $description (code $? $!):\n$doc\n");
1332 &transcript("Sending $description.\n");
1333 &sendmailmessage(<<END.$doc,$replyto);
1334 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1336 Subject: $gProject $gBugs information: $description
1337 References: $header{'message-id'}
1338 In-Reply-To: $header{'message-id'}
1339 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1341 X-$gProject-PR-Message: doc-html $relpath
1350 $maintccreasons{$cca}{''}{$ref}= 1;
1353 sub addmaintainers {
1354 # Data structure is:
1355 # maintainer email address &c -> assoc of packages -> assoc of bug#'s
1358 &ensuremaintainersloaded;
1359 $anymaintfound=0; $anymaintnotfound=0;
1360 for $p (split(m/[ \t?,():]+/, $data->{package})) {
1362 $p =~ /([a-z0-9.+-]+)/;
1364 next unless defined $p;
1365 if (defined $gSubscriptionDomain) {
1366 if (defined($pkgsrc{$p})) {
1367 addbcc("$pkgsrc{$p}\@$gSubscriptionDomain");
1369 addbcc("$p\@$gSubscriptionDomain");
1372 if (defined $data->{severity} and defined $gStrongList and
1373 isstrongseverity($data->{severity})) {
1374 addbcc("$gStrongList\@$gListDomain");
1376 if (defined($maintainerof{$p})) {
1377 $addmaint= $maintainerof{$p};
1378 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
1379 $maintccreasons{$addmaint}{$p}{$ref}= 1;
1380 print "maintainer add >$p|$addmaint<\n" if $debug;
1382 print "maintainer none >$p<\n" if $debug;
1383 &transcript("Warning: Unknown package '$p'\n");
1384 &transcript("MR|unknown-package|$p|$ref|\n") if $dl>2;
1385 $maintccreasons{$gUnknownMaintainerEmail}{$p}{$ref}= 1;
1389 if (length $data->{owner}) {
1390 $addmaint = $data->{owner};
1391 &transcript("MO|$addmaint|$data->{package}|$ref|\n") if $dl>2;
1392 $maintccreasons{$addmaint}{$data->{package}}{$ref} = 1;
1393 print "owner add >$data->{package}|$addmaint<\n" if $debug;
1397 sub ensuremaintainersloaded {
1399 return if $maintainersloaded++;
1400 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1404 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1405 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1406 $maintainerof{$1}= $2;
1409 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1413 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1414 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1415 $maintainerof{$1}= $2;
1418 open(SOURCES, "$gPackageSource") || &quit("pkgsrc open: $!");
1420 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1421 my ($a, $b) = ($1, $2);
1422 $pkgsrc{lc($a)} = $b;
1428 local ($wherefrom,$path,$description) = @_;
1429 if ($wherefrom eq "ftp.d.o") {
1430 $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or &quit("fork for lynx/gunzip: $!");
1432 if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1433 &transcript("$description is not available.\n");
1436 &transcript("Error getting $description (code $? $!):\n$doc\n");
1439 } elsif ($wherefrom eq "local") {
1441 $doc = do { local $/; <P> };
1444 &transcript("internal errror: info files location unknown.\n");
1447 &transcript("Sending $description.\n");
1448 &sendmailmessage(<<END.$doc,$replyto);
1449 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1451 Subject: $gProject $gBugs information: $description
1452 References: $header{'message-id'}
1453 In-Reply-To: $header{'message-id'}
1454 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1456 X-$gProject-PR-Message: getinfo
1458 $description follows: