scripts/service

   1 #!/usr/bin/perl
   2 # $Id: service.in,v 1.118 2005/10/19 01:22:14 don Exp $
   3 #
   4 # Usage: service <code>.nn
   5 # Temps:  incoming/P<code>.nn
   6
   7 use warnings;
   8 use strict;
   9
  10 use File::Copy;
  11 use MIME::Parser;
  12
  13 use Params::Validate qw(:types validate_with);
  14
  15 use Debbugs::Common qw(:util :quit :misc :lock)
  16
  17 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
  18 use Debbugs::Mail qw(send_mail_message);
  19 use Debbugs::User;
  20 use HTML::Entities qw(encode_entities);
  21 use Debbugs::Versions::Dpkg;
  22
  23 use Debbugs::Status qw(splitpackages);
  24
  25 use Debbugs::Config qw(:globals :config);
  26 use Debbugs::CGI qw(html_escape);
  27 use Debbugs::Control qw(:archive :log);
  28 use Debbugs::Log qw(:misc);
  29 use Debbugs::Text qw(:templates);
  30
  31 use Mail::RFC822::Address;
  32
  33 chdir($config{spoool_dir}) or
  34      die "Unable to chdir to spool_dir '$config{spool_dir}': $!";
  35
  36 my $debug = 0;
  37 umask(002);
  38
  39 my ($control, $nn) = $ARGV[0] =~ m/^([RC])\.(\d+)$/ || die "bad argument";
  40 if (!rename("incoming/G$nn","incoming/P$nn")) {
  41     defined $! and $! =~ m/no such file or directory/i and exit 0;
  42     die "Failed to rename incoming/G$nn to incoming/P$nn: $!";
  43 }
  44
  45 my $log_fh = IO::File->new("incoming/P$nn",'r') or
  46      die "Unable to open incoming/P$nn for reading: $!";
  47 my @log=<$log_fh>;
  48 my @msg=@log;
  49 close($log_fh);
  50
  51 chomp @msg;
  52
  53 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
  54
  55 # Bug numbers to send e-mail to, hash so that we don't send to the
  56 # same bug twice.
  57 my (%bug_affected);
  58
  59 my (@headerlines,@bodylines);
  60
  61 my $parse_output = Debbugs::MIME::parse(join('',@log));
  62 @headerlines = @{$parse_output->{header}};
  63 @bodylines = @{$parse_output->{body}};
  64
  65
  66 for (@headerlines) {
  67     $_ = decode_rfc1522($_);
  68     s/\n\s/ /g;
  69     print ">$_<\n" if $debug;
  70     if (s/^(\S+):\s*//) {
  71         my $v = lc $1;
  72         print ">$v=$_<\n" if $debug;
  73         $header{$v} = $_;
  74     } else {
  75         print "!>$_<\n" if $debug;
  76     }
  77 }
  78
  79 grep(s/\s+$//,@bodylines);
  80
  81 print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
  82
  83 if (defined $header{'resent-from'} && !defined $header{'from'}) {
  84     $header{'from'} = $header{'resent-from'};
  85 }
  86
  87 defined($header{'from'}) || die "no From header";
  88
  89 delete $header{'reply-to'}
  90         if ( defined($header{'reply-to'}) && $header{'reply-to'} =~ m/^\s*$/ );
  91
  92 my $replyto;
  93 if ( defined($header{'reply-to'}) && $header{'reply-to'} ne "" ) {
  94     $replyto = $header{'reply-to'};
  95 } else {
  96     $replyto = $header{'from'};
  97 }
  98
  99 # This is an error counter which should be incremented every time there is an error.
 100 my $errors = 0;
 101 my $controlrequestaddr= ($control ? 'control' : 'request').$config{email_domain};
 102 my $transcript_scalar = '';
 103 my $transcript = IO::Scalar->new(\$transcript_scalar) or
 104      die "Unable to create new IO::Scalar";
 105 print {$stranscript} "Processing commands for $controlrequestaddr:\n\n";
 106
 107 # debug level
 108 my $dl= 0;
 109 my $state= 'idle';
 110 my $lowstate= 'idle';
 111 my $mergelowstate= 'idle';
 112 my $midix=0;
 113 my $extras="";
 114
 115 my $user = $replyto;
 116 $user =~ s/,.*//;
 117 $user =~ s/^.*<(.*)>.*$/$1/;
 118 $user =~ s/[(].*[)]//;
 119 $user =~ s/^\s*(\S+)\s+.*$/$1/;
 120 $user = "" unless (Debbugs::User::is_valid_user($user));
 121 my $indicated_user = 0;
 122
 123 my $quickabort = 0;
 124
 125
 126 if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) {
 127         print {$transcript} fill_template('mail/excluded_from_control');
 128         $quickabort = 1;
 129 }
 130
 131 my %limit_pkgs = ();
 132 my %clonebugs = ();
 133 my %bcc = ();
 134
 135 sub addbcc {
 136     push @bcc, $_[0] unless grep { $_ eq $_[0] } @bcc;
 137 }
 138
 139 for ($procline=0; $procline<=$#bodylines; $procline++) {
 140     $state eq 'idle' || print "state: $state ?\n";
 141     $lowstate eq 'idle' || print "lowstate: $lowstate ?\n";
 142     $mergelowstate eq 'idle' || print "mergelowstate: $mergelowstate ?\n";
 143     if ($quickabort) {
 144          print {$transcript} "Stopping processing here.\n\n";
 145          last;
 146     }
 147     $_= $bodylines[$procline]; s/\s+$//;
 148     next unless m/\S/;
 149     print {$transcript} "> $_\n";
 150     next if m/^\s*\#/;
 151     $action= '';
 152     if (m/^stop\s*$/i || m/^quit\s*$/i || m/^--\s*$/ || m/^thank(?:s|\s*you)?\s*$/i || m/^kthxbye\s*$/i) {
 153         print {$transcript} "Stopping processing here.\n\n";
 154         last;
 155     } elsif (m/^debug\s+(\d+)$/i && $1 >= 0 && $1 <= 1000) {
 156         $dl= $1+0;
 157         print {$transcript} "Debug level $dl.\n\n";
 158     } elsif (m/^(send|get)\s+\#?(\d{2,})$/i) {
 159         $ref= $2+0;
 160         &sendlynxdoc("bugreport.cgi?bug=$ref","logs for $gBug#$ref");
 161     } elsif (m/^send-detail\s+\#?(\d{2,})$/i) {
 162         $ref= $1+0;
 163         &sendlynxdoc("bugreport.cgi?bug=$ref&boring=yes",
 164                      "detailed logs for $gBug#$ref");
 165     } elsif (m/^index(\s+full)?$/i) {
 166         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 167         $errors++;
 168         $ok++; # well, it's not really ok, but it fixes #81224 :)
 169     } elsif (m/^index-summary\s+by-package$/i) {
 170         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 171         $errors++;
 172         $ok++; # well, it's not really ok, but it fixes #81224 :)
 173     } elsif (m/^index-summary(\s+by-number)?$/i) {
 174         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 175         $errors++;
 176         $ok++; # well, it's not really ok, but it fixes #81224 :)
 177     } elsif (m/^index(\s+|-)pack(age)?s?$/i) {
 178         &sendlynxdoc("pkgindex.cgi?indexon=pkg",'index of packages');
 179     } elsif (m/^index(\s+|-)maints?$/i) {
 180         &sendlynxdoc("pkgindex.cgi?indexon=maint",'index of maintainers');
 181     } elsif (m/^index(\s+|-)maint\s+(\S+)$/i) {
 182         $maint = $2;
 183         &sendlynxdoc("pkgreport.cgi?maint=" . urlsanit($maint),
 184                      "$gBug list for maintainer \`$maint'");
 185         $ok++;
 186     } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/i) {
 187         $package = $+;
 188         &sendlynxdoc("pkgreport.cgi?pkg=" . urlsanit($package),
 189                      "$gBug list for package $package");
 190         $ok++;
 191     } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/i) {
 192         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 193         $errors++;
 194         $ok++; # well, it's not really ok, but it fixes #81224 :)
 195     } elsif (m/^send-unmatched\s+(last|-1)$/i) {
 196         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 197         $errors++;
 198         $ok++; # well, it's not really ok, but it fixes #81224 :)
 199     } elsif (m/^send-unmatched\s+(old|-2)$/i) {
 200         print {$transcript} "This BTS function is currently disabled, sorry.\n\n";
 201         $errors++;
 202         $ok++; # well, it's not really ok, but it fixes #81224 :)
 203     } elsif (m/^getinfo\s+([\w-.]+)$/i) {
 204         # the following is basically a Debian-specific kludge, but who cares
 205         $req = $1;
 206         if ($req =~ /^maintainers$/i && -f "$gConfigDir/Maintainers") {
 207             &sendinfo("local", "$gConfigDir/Maintainers", "Maintainers file");
 208         } elsif ($req =~ /^override\.(\w+)\.([\w-.]+)$/i) {
 209             $req =~ s/.gz$//;
 210             &sendinfo("ftp.d.o", "$req", "override file for $2 part of $1 distribution");
 211         } elsif ($req =~ /^pseudo-packages\.(description|maintainers)$/i && -f "$gConfigDir/$req") {
 212             &sendinfo("local", "$gConfigDir/$req", "$req file");
 213         } else {
 214             print {$transcript} "Info file $req does not exist.\n\n";
 215         }
 216     } elsif (m/^help/i) {
 217         &sendhelp;
 218         print {$transcript} "\n";
 219         $ok++;
 220     } elsif (m/^refcard/i) {
 221         &sendtxthelp("bug-mailserver-refcard.txt","mail servers' reference card");
 222     } elsif (m/^subscribe/i) {
 223         print {$transcript} <<END;
 224 There is no $gProject $gBug mailing list.  If you wish to review bug reports
 225 please do so via http://$gWebDomain/ or ask this mail server
 226 to send them to you.
 227 soon: MAILINGLISTS_TEXT
 228 END
 229     } elsif (m/^unsubscribe/i) {
 230         print {$transcript} <<END;
 231 soon: UNSUBSCRIBE_TEXT
 232 soon: MAILINGLISTS_TEXT
 233 END
 234     } elsif (m/^user\s+(\S+)\s*$/i) {
 235         my $newuser = $1;
 236         if (Debbugs::User::is_valid_user($newuser)) {
 237             my $olduser = ($user ne "" ? " (was $user)" : "");
 238             print {$transcript} "Setting user to $newuser$olduser.\n";
 239             $user = $newuser;
 240             $indicated_user = 1;
 241         } else {
 242             print {$transcript} "Selected user id ($newuser) invalid, sorry\n";
 243             $errors++;
 244             $user = "";
 245             $indicated_user = 1;
 246         }
 247     } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
 248         $ok++;
 249         my $catname = $1;
 250         my $hidden = ($2 ne "");
 251
 252         my $prefix = "";
 253         my @cats;
 254         my $bad = 0;
 255         my $catsec = 0;
 256         if ($user eq "") {
 257             print {$transcript} "No valid user selected\n";
 258             $errors++;
 259             next;
 260         }
 261         if (not $indicated_user and defined $user) {
 262              print {$transcript} "User is $user\n";
 263              $indicated_user = 1;
 264         }
 265         while (++$procline <= $#bodylines) {
 266             unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
 267                 $procline--;
 268                 last;
 269             }
 270             print {$transcript} "> $bodylines[$procline]\n";
 271             next if $bad;
 272             my ($o, $txt) = ($1, $2);
 273             if ($#cats == -1 && $o eq "+") {
 274                 print {$transcript} "User defined category specification must start with a category name. Skipping.\n\n";
 275                 $errors++;
 276                 $bad = 1;
 277                 next;
 278             }
 279             if ($o eq "+") {
 280                 unless (ref($cats[-1]) eq "HASH") {
 281                     $cats[-1] = { "nam" => $cats[-1],
 282                                   "pri" => [], "ttl" => [] };
 283                 }
 284                 $catsec++;
 285                 my ($desc, $ord, $op);
 286                 if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
 287                     $desc = $1; $ord = $3; $op = "";
 288                 } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
 289                     $desc = $1; $ord = $3; $op = $4;
 290                 } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
 291                     $desc = ""; $op = $1;
 292                 } else {
 293                     print {$transcript} "Unrecognised syntax for category section. Skipping.\n\n";
 294                     $errors++;
 295                     $bad = 1;
 296                     next;
 297                 }
 298                 $ord = 999 unless defined $ord;
 299
 300                 if ($op) {
 301                     push @{$cats[-1]->{"pri"}}, $prefix . $op;
 302                     push @{$cats[-1]->{"ttl"}}, $desc;
 303                     push @ords, "$ord $catsec";
 304                 } else {
 305                     @cats[-1]->{"def"} = $desc;
 306                     push @ords, "$ord DEF";
 307                     $catsec--;
 308                 }
 309                 @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
 310                                $a1 <=> $b1 || $a2 <=> $b2; } @ords;
 311                 $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
 312             } elsif ($o eq "*") {
 313                 $catsec = 0;
 314                 my ($name);
 315                 if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
 316                     $name = $1; $prefix = $3;
 317                 } else {
 318                     $name = $txt; $prefix = "";
 319                 }
 320                 push @cats, $name;
 321             }
 322         }
 323         # XXX: got @cats, now do something with it
 324         my $u = Debbugs::User::get_user($user);
 325         if (@cats) {
 326             print {$transcript} "Added usercategory $catname.\n\n";
 327             $u->{"categories"}->{$catname} = [ @cats ];
 328             if (not $hidden) {
 329                  push @{$u->{visible_cats}},$catname;
 330             }
 331         } else {
 332             print {$transcript} "Removed usercategory $catname.\n\n";
 333             delete $u->{"categories"}->{$catname};
 334             @{$u->{visible_cats}} = grep {$_ ne $catname} @{$u->{visible_cats}};
 335         }
 336         $u->write();
 337     } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
 338         $ok++;
 339         $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
 340         if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
 341              $ref = $clonebugs{$ref};
 342         }
 343         if ($user eq "") {
 344             print {$transcript} "No valid user selected\n";
 345             $errors++;
 346             $indicated_user = 1;
 347         } elsif (&setbug) {
 348             if (not $indicated_user and defined $user) {
 349                  print {$transcript} "User is $user\n";
 350                  $indicated_user = 1;
 351             }
 352             &nochangebug;
 353             my %ut;
 354             Debbugs::User::read_usertags(\%ut, $user);
 355             my @oldtags = (); my @newtags = (); my @badtags = ();
 356             my %chtags;
 357             for my $t (split /[,\s]+/, $tags) {
 358                 if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
 359                     $chtags{$t} = 1;
 360                 } else {
 361                     push @badtags, $t;
 362                 }
 363             }
 364             if (@badtags) {
 365                 print {$transcript} "Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n";
 366                 $errors++;
 367             }
 368             for my $t (keys %chtags) {
 369                 $ut{$t} = [] unless defined $ut{$t};
 370             }
 371             for my $t (keys %ut) {
 372                 my %res = map { ($_, 1) } @{$ut{$t}};
 373                 push @oldtags, $t if defined $res{$ref};
 374                 my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
 375                 my $del = (defined $chtags{$t} ? $addsubcode eq "-"
 376                                                : $addsubcode eq "=");
 377                 $res{$ref} = 1 if ($addop && defined $chtags{$t});
 378                 delete $res{$ref} if ($del);
 379                 push @newtags, $t if defined $res{$ref};
 380                 $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
 381             }
 382             if (@oldtags == 0) {
 383                 print {$transcript} "There were no usertags set.\n";
 384             } else {
 385                 print {$transcript} "Usertags were: " . join(" ", @oldtags) . ".\n";
 386             }
 387             print {$transcript} "Usertags are now: " . join(" ", @newtags) . ".\n";
 388             Debbugs::User::write_usertags(\%ut, $user);
 389         }
 390     } elsif (!$control) {
 391         print {$transcript} <<END;
 392 Unknown command or malformed arguments to command.
 393 (Use control\@$gEmailDomain to manipulate reports.)
 394
 395 END
 396         $errors++;
 397         if (++$unknowns >= 3) {
 398             print {$transcript} "Too many unknown commands, stopping here.\n\n";
 399             last;
 400         }
 401 #### "developer only" ones start here
 402     } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
 403         $ok++;
 404         $ref= $1;
 405         $bug_affected{$ref}=1;
 406         $version= $2;
 407         if (&setbug) {
 408             print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
 409             if (length($data->{done}) and not defined($version)) {
 410                 print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
 411                 &nochangebug;
 412             } else {
 413                 $action= "$gBug " .
 414                     (defined($version) ?
 415                         "marked as fixed in version $version" :
 416                         "closed") .
 417                     ", send any further explanations to $data->{originator}";
 418                 do {
 419                     &addmaintainers($data);
 420                                         if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
 421                                         0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
 422                     $data->{done}= $replyto;
 423                     my @keywords= split ' ', $data->{keywords};
 424                     if (grep $_ eq 'pending', @keywords) {
 425                         $extramessage= "Removed pending tag.\n";
 426                         $data->{keywords}= join ' ', grep $_ ne 'pending',
 427                                                 @keywords;
 428                     }
 429                     addfixedversions($data, $data->{package}, $version, 'binary');
 430
 431                     $message= <<END;
 432 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 433 To: $data->{originator}
 434 Subject: $gBug#$ref acknowledged by developer
 435          ($header{'subject'})
 436 References: $header{'message-id'} $data->{msgid}
 437 In-Reply-To: $data->{msgid}
 438 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
 439 Reply-To: $ref\@$gEmailDomain
 440 X-$gProject-PR-Message: they-closed-control $ref
 441
 442 This is an automatic notification regarding your $gBug report
 443 #$ref: $data->{subject},
 444 which was filed against the $data->{package} package.
 445
 446 It has been marked as closed by one of the developers, namely
 447 $replyto.
 448
 449 You should be hearing from them with a substantive response shortly,
 450 in case you haven't already. If not, please contact them directly.
 451
 452 $gMaintainer
 453 (administrator, $gProject $gBugs database)
 454
 455 END
 456                     &sendmailmessage($message,$data->{originator});
 457                 } while (&getnextbug);
 458             }
 459         }
 460     } elsif (m/^reassign\s+\#?(-?\d+)\s+(\S+)(?:\s+(\d.*))?$/i) {
 461         $ok++;
 462         $ref= $1; $newpackage= $2;
 463         $bug_affected{$ref}=1;
 464         $version= $3;
 465         $newpackage =~ y/A-Z/a-z/;
 466         if (&setbug) {
 467             if (length($data->{package})) {
 468                 $action= "$gBug reassigned from package \`$data->{package}'".
 469                          " to \`$newpackage'.";
 470             } else {
 471                 $action= "$gBug assigned to package \`$newpackage'.";
 472             }
 473             do {
 474                 &addmaintainers($data);
 475                 $data->{package}= $newpackage;
 476                 $data->{found_versions}= [];
 477                 $data->{fixed_versions}= [];
 478                 # TODO: what if $newpackage is a source package?
 479                 addfoundversions($data, $data->{package}, $version, 'binary');
 480                 &addmaintainers($data);
 481             } while (&getnextbug);
 482         }
 483     } elsif (m/^reopen\s+\#?(-?\d+)$/i ? ($noriginator='', 1) :
 484              m/^reopen\s+\#?(-?\d+)\s+\=$/i ? ($noriginator='', 1) :
 485              m/^reopen\s+\#?(-?\d+)\s+\!$/i ? ($noriginator=$replyto, 1) :
 486              m/^reopen\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($noriginator=$2, 1) : 0) {
 487         $ok++;
 488         $ref= $1;
 489         $bug_affected{$ref}=1;
 490         if (&setbug) {
 491             if (@{$data->{fixed_versions}}) {
 492                 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\nyou may need to use 'found' to remove fixed versions.\n";
 493             }
 494             if (!length($data->{done})) {
 495                 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
 496                 &nochangebug;
 497             } else {
 498                 $action=
 499                     $noriginator eq '' ? "$gBug reopened, originator not changed." :
 500                         "$gBug reopened, originator set to $noriginator.";
 501                 do {
 502                     &addmaintainers($data);
 503                     $data->{originator}= $noriginator eq '' ?  $data->{originator} : $noriginator;
 504                     $data->{fixed_versions}= [];
 505                     $data->{done}= '';
 506                 } while (&getnextbug);
 507             }
 508         }
 509     } elsif (m{^found\s+\#?(-?\d+)
 510                (?:\s+((?:$config{package_name_re}\/)?
 511                     $config{package_version_re}))?$}ix) {
 512         $ok++;
 513         $ref= $1;
 514         $version= $2;
 515         if (&setbug) {
 516             if (!length($data->{done}) and not defined($version)) {
 517                 print {$transcript} "$gBug is already open, cannot reopen.\n\n";
 518                 $errors++;
 519                 &nochangebug;
 520             } else {
 521                 $action=
 522                     defined($version) ?
 523                         "$gBug marked as found in version $version." :
 524                         "$gBug reopened.";
 525                 do {
 526                     &addmaintainers($data);
 527                     # The 'done' field gets a bit weird with version
 528                     # tracking, because a bug may be closed by multiple
 529                     # people in different branches. Until we have something
 530                     # more flexible, we set it every time a bug is fixed,
 531                     # and clear it when a bug is found in a version greater
 532                     # than any version in which the bug is fixed or when
 533                     # a bug is found and there is no fixed version
 534                     if (defined $version) {
 535                         my ($version_only) = $version =~ m{([^/]+)$};
 536                         addfoundversions($data, $data->{package}, $version, 'binary');
 537                         my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
 538                              map {s{.+/}{}; $_;} @{$data->{fixed_versions}};
 539                         if (not @fixed_order or (Debbugs::Versions::Dpkg::vercmp($version_only,$fixed_order[-1]) >= 0)) {
 540                              $action = "$gBug marked as found in version $version and reopened."
 541                                   if length $data->{done};
 542                              $data->{done} = '';
 543                         }
 544                     } else {
 545                         # Versionless found; assume old-style "not fixed at
 546                         # all".
 547                         $data->{fixed_versions} = [];
 548                         $data->{done} = '';
 549                     }
 550                 } while (&getnextbug);
 551             }
 552         }
 553     } elsif (m[^notfound\s+\#?(-?\d+)\s+
 554                ((?:$config{package_name_re}\/)?
 555                     \S+)\s*$]ix) {
 556         $ok++;
 557         $ref= $1;
 558         $version= $2;
 559         if (&setbug) {
 560             $action= "$gBug no longer marked as found in version $version.";
 561             if (length($data->{done})) {
 562                 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
 563             }
 564             do {
 565                 &addmaintainers($data);
 566                 removefoundversions($data, $data->{package}, $version, 'binary');
 567             } while (&getnextbug);
 568        }
 569    }
 570     elsif (m[^fixed\s+\#?(-?\d+)\s+
 571              ((?:$config{package_name_re}\/)?
 572                   $config{package_version_re})\s*$]ix) {
 573         $ok++;
 574         $ref= $1;
 575         $version= $2;
 576         if (&setbug) {
 577              $action=
 578                   defined($version) ?
 579                        "$gBug marked as fixed in version $version." :
 580                             "$gBug reopened.";
 581                 do {
 582                     &addmaintainers($data);
 583                     addfixedversions($data, $data->{package}, $version, 'binary');
 584                } while (&getnextbug);
 585         }
 586    }
 587     elsif (m[^notfixed\s+\#?(-?\d+)\s+
 588              ((?:$config{package_name_re}\/)?
 589                   \S+)\s*$]ix) {
 590         $ok++;
 591         $ref= $1;
 592         $version= $2;
 593         if (&setbug) {
 594              $action=
 595                   defined($version) ?
 596                        "$gBug no longer marked as fixed in version $version." :
 597                             "$gBug reopened.";
 598                 do {
 599                     &addmaintainers($data);
 600                     removefixedversions($data, $data->{package}, $version, 'binary');
 601                } while (&getnextbug);
 602         }
 603    }
 604     elsif (m/^submitter\s+\#?(-?\d+)\s+\!$/i ? ($newsubmitter=$replyto, 1) :
 605              m/^submitter\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newsubmitter=$2, 1) : 0) {
 606         $ok++;
 607         $ref= $1;
 608         $bug_affected{$ref}=1;
 609         if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
 610             $ref = $clonebugs{$ref};
 611         }
 612         if (not Mail::RFC822::Address::valid($newsubmitter)) {
 613              transcript("$newsubmitter is not a valid e-mail address; not changing submitter\n");
 614              $errors++;
 615         }
 616         elsif (&getbug) {
 617             if (&checkpkglimit) {
 618                 &foundbug;
 619                 &addmaintainers($data);
 620                 $oldsubmitter= $data->{originator};
 621                 $data->{originator}= $newsubmitter;
 622                 $action= "Changed $gBug submitter from $oldsubmitter to $newsubmitter.";
 623                 &savebug;
 624                 print {$transcript} "$action\n";
 625                 if (length($data->{done})) {
 626                     print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
 627                 }
 628                 print {$transcript} "\n";
 629                 $message= <<END;
 630 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 631 To: $oldsubmitter
 632 Subject: $gBug#$ref submitter address changed
 633          ($header{'subject'})
 634 References: $header{'message-id'} $data->{msgid}
 635 In-Reply-To: $data->{msgid}
 636 Message-ID: <handler.$ref.$nn.newsubmitter.$midix\@$gEmailDomain>
 637 Reply-To: $ref\@$gEmailDomain
 638 X-$gProject-PR-Message: submitter-changed $ref
 639
 640 The submitter address recorded for your $gBug report
 641 #$ref: $data->{subject}
 642 has been changed.
 643
 644 The old submitter address for this report was
 645 $oldsubmitter.
 646 The new submitter address is
 647 $newsubmitter.
 648
 649 This change was made by
 650 $replyto.
 651 If it was incorrect, please contact them directly.
 652
 653 $gMaintainer
 654 (administrator, $gProject $gBugs database)
 655
 656 END
 657                 &sendmailmessage($message,$oldsubmitter);
 658             } else {
 659                 &cancelbug;
 660             }
 661         } else {
 662             &notfoundbug;
 663         }
 664     } elsif (m/^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/i) {
 665         $ok++;
 666         $ref= $1; $whereto= $2;
 667         $bug_affected{$ref}=1;
 668         if (&setbug) {
 669             if (length($data->{forwarded})) {
 670     $action= "Forwarded-to-address changed from $data->{forwarded} to $whereto.";
 671             } else {
 672     $action= "Noted your statement that $gBug has been forwarded to $whereto.";
 673             }
 674             if (length($data->{done})) {
 675                 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
 676             }
 677             do {
 678                 &addmaintainers($data);
 679                 if (length($gForwardList)>0 && length($gListDomain)>0 ) {
 680                      &addccaddress("$gForwardList\@$gListDomain");
 681                 }
 682                 $data->{forwarded}= $whereto;
 683             } while (&getnextbug);
 684         }
 685     } elsif (m/^notforwarded\s+\#?(-?\d+)$/i) {
 686         $ok++;
 687         $ref= $1;
 688         $bug_affected{$ref}=1;
 689         if (&setbug) {
 690             if (!length($data->{forwarded})) {
 691                 print {$transcript} "$gBug is not marked as having been forwarded.\n\n";
 692                 &nochangebug;
 693             } else {
 694     $action= "Removed annotation that $gBug had been forwarded to $data->{forwarded}.";
 695                 do {
 696                     &addmaintainers($data);
 697                     $data->{forwarded}= '';
 698                 } while (&getnextbug);
 699             }
 700         }
 701     } elsif (m/^severity\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i ||
 702         m/^priority\s+\#?(-?\d+)\s+([-0-9a-z]+)$/i) {
 703         $ok++;
 704         $ref= $1;
 705         $bug_affected{$ref}=1;
 706         $newseverity= $2;
 707         if (!grep($_ eq $newseverity, @gSeverityList, "$gDefaultSeverity")) {
 708              print {$transcript} "Severity level \`$newseverity' is not known.\n".
 709                   "Recognized are: $gShowSeverities.\n\n";
 710             $errors++;
 711         } elsif (exists $gObsoleteSeverities{$newseverity}) {
 712             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
 713                  "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
 714                 $errors++;
 715         } elsif (&setbug) {
 716             $printseverity= $data->{severity};
 717             $printseverity= "$gDefaultSeverity" if $printseverity eq '';
 718             $action= "Severity set to \`$newseverity' from \`$printseverity'";
 719             do {
 720                 &addmaintainers($data);
 721                 if (defined $gStrongList and isstrongseverity($newseverity)) {
 722                     addbcc("$gStrongList\@$gListDomain");
 723                 }
 724                 $data->{severity}= $newseverity;
 725             } while (&getnextbug);
 726         }
 727     } elsif (m/^tags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
 728         $ok++;
 729         $ref = $1; $addsubcode = $3; $tags = $4;
 730         $bug_affected{$ref}=1;
 731         $addsub = "add";
 732         if (defined $addsubcode) {
 733             $addsub = "sub" if ($addsubcode eq "-");
 734             $addsub = "add" if ($addsubcode eq "+");
 735             $addsub = "set" if ($addsubcode eq "=");
 736         }
 737         my @okaytags = ();
 738         my @badtags = ();
 739         foreach my $t (split /[\s,]+/, $tags) {
 740             if (!grep($_ eq $t, @gTags)) {
 741                 push @badtags, $t;
 742             } else {
 743                 push @okaytags, $t;
 744             }
 745         }
 746         if (@badtags) {
 747             print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
 748                  "Recognized are: ".join(' ', @gTags).".\n\n";
 749             $errors++;
 750         }
 751         if (&setbug) {
 752             if ($data->{keywords} eq '') {
 753                 print {$transcript} "There were no tags set.\n";
 754             } else {
 755                 print {$transcript} "Tags were: $data->{keywords}\n";
 756             }
 757             if ($addsub eq "set") {
 758                 $action= "Tags set to: " . join(", ", @okaytags);
 759             } elsif ($addsub eq "add") {
 760                 $action= "Tags added: " . join(", ", @okaytags);
 761             } elsif ($addsub eq "sub") {
 762                 $action= "Tags removed: " . join(", ", @okaytags);
 763             }
 764             do {
 765                 &addmaintainers($data);
 766                 $data->{keywords} = '' if ($addsub eq "set");
 767                 # Allow removing obsolete tags.
 768                 if ($addsub eq "sub") {
 769                     foreach my $t (@badtags) {
 770                         $data->{keywords} = join ' ', grep $_ ne $t,
 771                             split ' ', $data->{keywords};
 772                     }
 773                 }
 774                 # Now process all other additions and subtractions.
 775                 foreach my $t (@okaytags) {
 776                     $data->{keywords} = join ' ', grep $_ ne $t,
 777                         split ' ', $data->{keywords};
 778                     $data->{keywords} = "$t $data->{keywords}" unless($addsub eq "sub");
 779                 }
 780                 $data->{keywords} =~ s/\s*$//;
 781             } while (&getnextbug);
 782         }
 783     } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(by|with)\s+(\S.*)?$/i) {
 784         $ok++;
 785         my $bugnum = $2; my $blockers = $4;
 786         $addsub = "add";
 787         $addsub = "sub" if ($1 eq "un");
 788         if ($bugnum =~ m/^-\d+$/ && defined $clonebugs{$bugnum}) {
 789              $bugnum = $clonebugs{$bugnum};
 790         }
 791
 792         my @okayblockers;
 793         my @badblockers;
 794         foreach my $b (split /[\s,]+/, $blockers) {
 795             $b=~s/^\#//;
 796             if ($b=~/[0-9]+/) {
 797                 $ref=$b;
 798                 if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
 799                      $ref = $clonebugs{$ref};
 800                 }
 801                 if (&getbug) {
 802                     &foundbug;
 803                     push @okayblockers, $ref;
 804
 805                     # add to the list all bugs that are merged with $b,
 806                     # because all of their data must be kept in sync
 807                     @thisbugmergelist= split(/ /,$data->{mergedwith});
 808                     &cancelbug;
 809
 810                     foreach $ref (@thisbugmergelist) {
 811                         if (&getbug) {
 812                            push @okayblockers, $ref;
 813                            &cancelbug;
 814                         }
 815                     }
 816                 }
 817                 else {
 818                     &notfoundbug;
 819                     push @badblockers, $ref;
 820                 }
 821             }
 822             else {
 823                 push @badblockers, $b;
 824             }
 825         }
 826         if (@badblockers) {
 827             print {$transcript} "Unknown blocking bug/s: ".join(', ', @badblockers).".\n";
 828             $errors++;
 829         }
 830
 831         $ref=$bugnum;
 832         if (&setbug) {
 833             if ($data->{blockedby} eq '') {
 834                 print {$transcript} "Was not blocked by any bugs.\n";
 835             } else {
 836                 print {$transcript} "Was blocked by: $data->{blockedby}\n";
 837             }
 838             if ($addsub eq "set") {
 839                 $action= "Blocking bugs of $bugnum set to: " . join(", ", @okayblockers);
 840             } elsif ($addsub eq "add") {
 841                 $action= "Blocking bugs of $bugnum added: " . join(", ", @okayblockers);
 842             } elsif ($addsub eq "sub") {
 843                 $action= "Blocking bugs of $bugnum removed: " . join(", ", @okayblockers);
 844             }
 845             my %removedblocks;
 846             my %addedblocks;
 847             do {
 848                 &addmaintainers($data);
 849                 my @oldblockerlist = split ' ', $data->{blockedby};
 850                 $data->{blockedby} = '' if ($addsub eq "set");
 851                 foreach my $b (@okayblockers) {
 852                         $data->{blockedby} = manipset($data->{blockedby}, $b,
 853                                 ($addsub ne "sub"));
 854                 }
 855
 856                 foreach my $b (@oldblockerlist) {
 857                         if (! grep { $_ eq $b } split ' ', $data->{blockedby}) {
 858                                 push @{$removedblocks{$b}}, $ref;
 859                         }
 860                 }
 861                 foreach my $b (split ' ', $data->{blockedby}) {
 862                         if (! grep { $_ eq $b } @oldblockerlist) {
 863                                 push @{$addedblocks{$b}}, $ref;
 864                         }
 865                 }
 866             } while (&getnextbug);
 867
 868             # Now that the blockedby data is updated, change blocks data
 869             # to match the changes.
 870             foreach $ref (keys %addedblocks) {
 871                 if (&getbug) {
 872                     foreach my $b (@{$addedblocks{$ref}}) {
 873                         $data->{blocks} = manipset($data->{blocks}, $b, 1);
 874                     }
 875                     &savebug;
 876                 }
 877             }
 878             foreach $ref (keys %removedblocks) {
 879                 if (&getbug) {
 880                     foreach my $b (@{$removedblocks{$ref}}) {
 881                         $data->{blocks} = manipset($data->{blocks}, $b, 0);
 882                     }
 883                     &savebug;
 884                 }
 885             }
 886         }
 887     } elsif (m/^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/i) {
 888         $ok++;
 889         $ref= $1; $newtitle= $2;
 890         $bug_affected{$ref}=1;
 891         if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
 892             $ref = $clonebugs{$ref};
 893         }
 894         if (&getbug) {
 895             if (&checkpkglimit) {
 896                 &foundbug;
 897                 &addmaintainers($data);
 898                 my $oldtitle = $data->{subject};
 899                 $data->{subject}= $newtitle;
 900                 $action= "Changed $gBug title to `$newtitle' from `$oldtitle'.";
 901                 &savebug;
 902                 print {$transcript} "$action\n";
 903                 if (length($data->{done})) {
 904                     print {$transcript} "(By the way, that $gBug is currently marked as done.)\n";
 905                 }
 906                 print {$transcript} "\n";
 907             } else {
 908                 &cancelbug;
 909             }
 910         } else {
 911             &notfoundbug;
 912         }
 913     } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
 914         $ok++;
 915         $ref= $1;
 916         $bug_affected{$ref} = 1;
 917         if (&setbug) {
 918             if (!length($data->{mergedwith})) {
 919                 print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
 920                 &nochangebug;
 921             } else {
 922                 $mergelowstate eq 'locked' || die "$mergelowstate ?";
 923                 $action= "Disconnected #$ref from all other report(s).";
 924                 @newmergelist= split(/ /,$data->{mergedwith});
 925                 $discref= $ref;
 926                 @bug_affected{@newmergelist} = 1 x @newmergelist;
 927                 do {
 928                     &addmaintainers($data);
 929                     $data->{mergedwith}= ($ref == $discref) ? ''
 930                         : join(' ',grep($_ ne $ref,@newmergelist));
 931                 } while (&getnextbug);
 932             }
 933         }
 934     } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
 935         $ok++;
 936         my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
 937         my @newmergelist= ();
 938         my %tags = ();
 939         my %found = ();
 940         my %fixed = ();
 941         &getmerge;
 942         while (defined($ref= shift(@tomerge))) {
 943             print {$transcript} "D| checking merge $ref\n" if $dl;
 944             $ref+= 0;
 945             if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
 946                 $ref = $clonebugs{$ref};
 947             }
 948             next if grep($_ == $ref,@newmergelist);
 949             if (!&getbug) { &notfoundbug; @newmergelist=(); last }
 950             if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
 951             &foundbug;
 952             print {$transcript} "D| adding $ref ($data->{mergedwith})\n") if $dl;
 953             $mismatch= '';
 954             &checkmatch('package','m_package',$data->{package},@newmergelist);
 955             &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
 956             $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
 957             &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
 958             &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
 959             &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
 960             &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
 961             &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
 962             foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
 963             foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
 964             foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
 965             if (length($mismatch)) {
 966                 print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
 967                      $mismatch."\n";
 968                 $errors++;
 969                 &cancelbug; @newmergelist=(); last;
 970             }
 971             push(@newmergelist,$ref);
 972             push(@tomerge,split(/ /,$data->{mergedwith}));
 973             &cancelbug;
 974         }
 975         if (@newmergelist) {
 976             @newmergelist= sort { $a <=> $b } @newmergelist;
 977             $action= "Merged @newmergelist.";
 978             delete @fixed{keys %found};
 979             for $ref (@newmergelist) {
 980                 &getbug || die "huh ?  $gBug $ref disappeared during merge";
 981                 &addmaintainers($data);
 982                 @bug_affected{@newmergelist} = 1 x @newmergelist;
 983                 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
 984                 $data->{keywords}= join(' ', keys %tags);
 985                 $data->{found_versions}= [sort keys %found];
 986                 $data->{fixed_versions}= [sort keys %fixed];
 987                 &savebug;
 988             }
 989             print {$transcript} "$action\n\n";
 990         }
 991         &endmerge;
 992     } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
 993         $ok++;
 994         my @temp = split /\s+\#?/,$1;
 995         my $master_bug = shift @temp;
 996         my $master_bug_data;
 997         my @tomerge = sort { $a <=> $b } @temp;
 998         unshift @tomerge,$master_bug;
 999         print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
1000         my @newmergelist= ();
1001         my %tags = ();
1002         my %found = ();
1003         my %fixed = ();
1004         # Here we try to do the right thing.
1005         # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
1006         # If not, we discard the found and fixed.
1007         # Everything else we set to the values of the first bug.
1008         &getmerge;
1009         while (defined($ref= shift(@tomerge))) {
1010             print {$transcript} "D| checking merge $ref\n" if $dl;
1011             $ref+= 0;
1012             if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
1013                 $ref = $clonebugs{$ref};
1014             }
1015             next if grep($_ == $ref,@newmergelist);
1016             if (!&getbug) { &notfoundbug; @newmergelist=(); last }
1017             if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
1018             &foundbug;
1019             print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
1020             $master_bug_data = $data if not defined $master_bug_data;
1021             if ($data->{package} ne $master_bug_data->{package}) {
1022                  print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
1023                      "$gBug $ref is not in the same package as $master_bug\n";
1024                 $errors++;
1025                 &cancelbug; @newmergelist=(); last;
1026             }
1027             for my $t (split /\s+/,$data->{keywords}) {
1028                  $tags{$t} = 1;
1029             }
1030             @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1031             @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1032             push(@newmergelist,$ref);
1033             push(@tomerge,split(/ /,$data->{mergedwith}));
1034             &cancelbug;
1035         }
1036         if (@newmergelist) {
1037             @newmergelist= sort { $a <=> $b } @newmergelist;
1038             $action= "Forcibly Merged @newmergelist.";
1039             delete @fixed{keys %found};
1040             for $ref (@newmergelist) {
1041                 &getbug || die "huh ?  $gBug $ref disappeared during merge";
1042                 &addmaintainers($data);
1043                 @bug_affected{@newmergelist} = 1 x @newmergelist;
1044                 $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
1045                 $data->{keywords}= join(' ', keys %tags);
1046                 $data->{found_versions}= [sort keys %found];
1047                 $data->{fixed_versions}= [sort keys %fixed];
1048                 my @field_list = qw(forwarded package severity blocks blockedby owner done);
1049                 @{$data}{@field_list} = @{$master_bug_data}{@field_list};
1050                 &savebug;
1051             }
1052             print {$transcript} "$action\n\n";
1053         }
1054         &endmerge;
1055     } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
1056         $ok++;
1057
1058         $origref = $1;
1059         @newclonedids = split /\s+/, $2;
1060         $newbugsneeded = scalar(@newclonedids);
1061
1062         $ref = $origref;
1063         $bug_affected{$ref} = 1;
1064         if (&setbug) {
1065             if (length($data->{mergedwith})) {
1066                 print {$transcript} "$gBug is marked as being merged with others. Use an existing clone.\n\n";
1067                 $errors++;
1068                 &nochangebug;
1069             } else {
1070                 &filelock("nextnumber.lock");
1071                 open(N,"nextnumber") || die "nextnumber: read: $!";
1072                 $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
1073                 $firstref= $v+0;  $v += $newbugsneeded;
1074                 open(NN,">nextnumber"); print NN "$v\n"; close(NN);
1075                 &unfilelock;
1076
1077                 $lastref = $firstref + $newbugsneeded - 1;
1078
1079                 if ($newbugsneeded == 1) {
1080                     $action= "$gBug $origref cloned as bug $firstref.";
1081                 } else {
1082                     $action= "$gBug $origref cloned as bugs $firstref-$lastref.";
1083                 }
1084
1085                 my $blocks = $data->{blocks};
1086                 my $blockedby = $data->{blockedby};
1087
1088                 &getnextbug;
1089                 my $ohash = get_hashname($origref);
1090                 my $clone = $firstref;
1091                 @bug_affected{@newclonedids} = 1 x @newclonedids;
1092                 for $newclonedid (@newclonedids) {
1093                     $clonebugs{$newclonedid} = $clone;
1094
1095                     my $hash = get_hashname($clone);
1096                     copy("db-h/$ohash/$origref.log", "db-h/$hash/$clone.log");
1097                     copy("db-h/$ohash/$origref.status", "db-h/$hash/$clone.status");
1098                     copy("db-h/$ohash/$origref.summary", "db-h/$hash/$clone.summary");
1099                     copy("db-h/$ohash/$origref.report", "db-h/$hash/$clone.report");
1100                     &bughook('new', $clone, $data);
1101
1102                     # Update blocking info of bugs blocked by or blocking the
1103                     # cloned bug.
1104                     foreach $ref (split ' ', $blocks) {
1105                         &getbug;
1106                         $data->{blockedby} = manipset($data->{blockedby}, $clone, 1);
1107                         &savebug;
1108                     }
1109                     foreach $ref (split ' ', $blockedby) {
1110                         &getbug;
1111                         $data->{blocks} = manipset($data->{blocks}, $clone, 1);
1112                         &savebug;
1113                     }
1114
1115                     $clone++;
1116                 }
1117             }
1118         }
1119     } elsif (m/^package\:?\s+(\S.*\S)?\s*$/i) {
1120         $ok++;
1121         my @pkgs = split /\s+/, $1;
1122         if (scalar(@pkgs) > 0) {
1123                 %limit_pkgs = map { ($_, 1) } @pkgs;
1124                 print {$transcript} "Ignoring bugs not assigned to: " .
1125                         join(" ", keys(%limit_pkgs)) . "\n\n";
1126         } else {
1127                 %limit_pkgs = ();
1128                 print {$transcript} "Not ignoring any bugs.\n\n";
1129         }
1130     } elsif (m/^owner\s+\#?(-?\d+)\s+!$/i ? ($newowner = $replyto, 1) :
1131              m/^owner\s+\#?(-?\d+)\s+(\S.*\S)$/i ? ($newowner = $2, 1) : 0) {
1132         $ok++;
1133         $ref = $1;
1134         $bug_affected{$ref} = 1;
1135         if (&setbug) {
1136             if (length $data->{owner}) {
1137                 $action = "Owner changed from $data->{owner} to $newowner.";
1138             } else {
1139                 $action = "Owner recorded as $newowner.";
1140             }
1141             if (length $data->{done}) {
1142                 $extramessage = "(By the way, this $gBug is currently " .
1143                                 "marked as done.)\n";
1144             }
1145             do {
1146                 &addmaintainers($data);
1147                 $data->{owner} = $newowner;
1148             } while (&getnextbug);
1149         }
1150     } elsif (m/^noowner\s+\#?(-?\d+)$/i) {
1151         $ok++;
1152         $ref = $1;
1153         $bug_affected{$ref} = 1;
1154         if (&setbug) {
1155             if (length $data->{owner}) {
1156                 $action = "Removed annotation that $gBug was owned by " .
1157                           "$data->{owner}.";
1158                 do {
1159                     &addmaintainers($data);
1160                     $data->{owner} = '';
1161                 } while (&getnextbug);
1162             } else {
1163                 print {$transcript} "$gBug is not marked as having an owner.\n\n";
1164                 &nochangebug;
1165             }
1166         }
1167     } elsif (m/^unarchive\s+#?(\d+)$/i) {
1168          $ok++;
1169          $ref = $1;
1170          $bug_affected{$ref} = 1;
1171          eval {
1172               bug_unarchive(bug        => $ref,
1173                             transcript => $transcript,
1174                             affected_bugs => \%bug_affected,
1175                             requester => $header{from},
1176                             request_addr => $controlrequestaddr,
1177                             message => \@log,
1178                            );
1179          };
1180          if ($@) {
1181               $errors++;
1182          }
1183     } elsif (m/^archive\s+#?(\d+)$/i) {
1184          $ok++;
1185          $ref = $1;
1186          $bug_affected{$ref} = 1;
1187          eval {
1188               bug_archive(bug => $ref,
1189                           transcript => \$transcript,
1190                           ignore_time => 1,
1191                           archive_unarchived => 0,
1192                           affected_bugs => \%bug_affected,
1193                           requester => $header{from},
1194                           request_addr => $controlrequestaddr,
1195                           message => \@log,
1196                          );
1197          };
1198          if ($@) {
1199               $errors++;
1200          }
1201     } else {
1202         print {$transcript} "Unknown command or malformed arguments to command.\n\n";
1203         $errors++;
1204         if (++$unknowns >= 5) {
1205             print {$transcript} "Too many unknown commands, stopping here.\n\n";
1206             last;
1207         }
1208     }
1209 }
1210 if ($procline>$#bodylines) {
1211     print {$transcript} ">\nEnd of message, stopping processing here.\n\n";
1212 }
1213 if (!$ok && !quickabort) {
1214     $errors++;
1215     print {$transcript} "No commands successfully parsed; sending the help text(s).\n";
1216     &sendhelp;
1217     print {$transcript} "\n";
1218 }
1219
1220 print {$transcript} "MC\n" if $dl>1;
1221 @maintccs= ();
1222 for $maint (keys %maintccreasons) {
1223 print {$transcript} "MM|$maint|\n" if $dl>1;
1224     next if $maint eq $replyto;
1225     $reasonstring= '';
1226     $reasonsref= $maintccreasons{$maint};
1227 print {$transcript} "MY|$maint|\n" if $dl>2;
1228     for $p (sort keys %$reasonsref) {
1229 print {$transcript} "MP|$p|\n" if $dl>2;
1230         $reasonstring.= ', ' if length($reasonstring);
1231         $reasonstring.= $p.' ' if length($p);
1232         $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
1233     }
1234     if (length($reasonstring) > 40) {
1235         (substr $reasonstring, 37) = "...";
1236     }
1237     $reasonstring = "" if (!defined($reasonstring));
1238     push(@maintccs,"$maint ($reasonstring)");
1239     push(@maintccaddrs,"$maint");
1240 }
1241
1242 $maintccs = "";
1243 if (@maintccs) {
1244     print {$transcript} "MC|@maintccs|\n" if $dl>2;
1245     $maintccs .= "Cc: " . join(",\n    ",@maintccs) . "\n";
1246 }
1247
1248 my %packagepr;
1249 for my $maint (keys %maintccreasons) {
1250      for my $package (keys %{$maintccreasons{$maint}}) {
1251           next unless length $package;
1252           $packagepr{$package} = 1;
1253      }
1254 }
1255 my $packagepr = '';
1256 $packagepr = "X-${gProject}-PR-Package: " . join(keys %packagepr) . "\n" if keys %packagepr;
1257
1258 # Add Bcc's to subscribed bugs
1259 push @bcc, map {"bugs=$_\@$gListDomain"} keys %bug_affected;
1260
1261 if (!defined $header{'subject'} || $header{'subject'} eq "") {
1262   $header{'subject'} = "your mail";
1263 }
1264
1265 # Error text here advertises how many errors there were
1266 my $error_text = $errors > 0 ? " (with $errors errors)":'';
1267
1268 $reply= <<END;
1269 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1270 To: $replyto
1271 ${maintccs}Subject: Processed${error_text}: $header{'subject'}
1272 In-Reply-To: $header{'message-id'}
1273 References: $header{'message-id'}
1274 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
1275 Precedence: bulk
1276 ${packagepr}X-$gProject-PR-Message: transcript
1277
1278 ${transcript}Please contact me if you need assistance.
1279
1280 $gMaintainer
1281 (administrator, $gProject $gBugs database)
1282 $extras
1283 END
1284
1285 $repliedshow= join(', ',$replyto,@maintccaddrs);
1286 # -1 is the service.in log
1287 &filelock("lock/-1");
1288 open(AP,">>db-h/-1.log") || die "open db-h/-1.log: $!";
1289 print(AP
1290       "\2\n$repliedshow\n\5\n$reply\n\3\n".
1291       "\6\n".
1292       "<strong>Request received</strong> from <code>".
1293       html_escape($header{'from'})."</code>\n".
1294       "to <code>".html_escape($controlrequestaddr)."</code>\n".
1295       "\3\n".
1296       "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/-1.log: $!";
1297 close(AP) || die "open db-h/-1.log: $!";
1298 &unfilelock;
1299 utime(time,time,"db-h");
1300
1301 &sendmailmessage($reply,exists $header{'x-debbugs-no-ack'}?():$replyto,@maintccaddrs,@bcc);
1302
1303 unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1304
1305 sub sendmailmessage {
1306     local ($message,@recips) = @_;
1307     $message = "X-Loop: $gMaintainerEmail\n" . $message;
1308     send_mail_message(message    => $message,
1309                       recipients => \@recips,
1310                      );
1311     $midix++;
1312 }
1313
1314 sub fill_template{
1315      my ($template,$extra_var) = @_;
1316      $extra_var ||={};
1317      my $variables = {config => \%config,
1318                       defined($ref)?(ref    => $ref):(),
1319                       defined($data)?(data  => $data):(),
1320                       %{$extra_var},
1321                      };
1322      my $hole_var = {'&bugurl' =>
1323                      sub{"$_[0]: ".
1324                               'http://'.$config{cgi_domain}.'/'.
1325                                    Debbugs::CGI::bug_url($_[0]);
1326                     }
1327                     };
1328      return fill_in_template(template => $template,
1329                              variables => $variables,
1330                              hole_var  => $hole_var,
1331                             );
1332 }
1333
1334 =head2 message_body_template
1335
1336      message_body_template('mail/ack',{ref=>'foo'});
1337
1338 Creates a message body using a template
1339
1340 =cut
1341
1342 sub message_body_template{
1343      my ($template,$extra_var) = @_;
1344      $extra_var ||={};
1345      my $body = fill_template($template,$extra_var);
1346      return fill_template('mail/message_body',
1347                           {%{$extra_var},
1348                            body => $body,
1349                           },
1350                          );
1351 }
1352
1353 sub sendhelp {
1354         &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
1355         &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
1356             if $control;
1357 }
1358
1359 #sub unimplemented {
1360 #    print {$transcript} "Sorry, command $_[0] not yet implemented.\n\n";
1361 #}
1362
1363 sub checkmatch {
1364     local ($string,$mvarname,$svarvalue,@newmergelist) = @_;
1365     local ($mvarvalue);
1366     if (@newmergelist) {
1367         eval "\$mvarvalue= \$$mvarname";
1368         print {$transcript} "D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n"
1369             if $dl;
1370         $mismatch .=
1371             "Values for \`$string' don't match:\n".
1372             " #$newmergelist[0] has \`$mvarvalue';\n".
1373             " #$ref has \`$svarvalue'\n"
1374             if $mvarvalue ne $svarvalue;
1375     } else {
1376          print {$transcript} "D| setupmatch \`$string' /$mvarname/$svarvalue/\n"
1377               if $dl;
1378         eval "\$$mvarname= \$svarvalue";
1379     }
1380 }
1381
1382 sub checkpkglimit {
1383     if (keys %limit_pkgs and not defined $limit_pkgs{$data->{package}}) {
1384         print {$transcript} "$gBug number $ref belongs to package $data->{package}, skipping.\n\n";
1385         $errors++;
1386         return 0;
1387     }
1388     return 1;
1389 }
1390
1391 sub manipset {
1392     my $list = shift;
1393     my $elt = shift;
1394     my $add = shift;
1395
1396     my %h = map { $_ => 1 } split ' ', $list;
1397     if ($add) {
1398         $h{$elt}=1;
1399     }
1400     else {
1401         delete $h{$elt};
1402     }
1403     return join ' ', sort keys %h;
1404 }
1405
1406 # High-level bug manipulation calls
1407 # Do announcements themselves
1408 #
1409 # Possible calling sequences:
1410 #    setbug (returns 0)
1411 #
1412 #    setbug (returns 1)
1413 #    &transcript(something)
1414 #    nochangebug
1415 #
1416 #    setbug (returns 1)
1417 #    $action= (something)
1418 #    do {
1419 #      (modify s_* variables)
1420 #    } while (getnextbug);
1421
1422 sub nochangebug {
1423     &dlen("nochangebug");
1424     $state eq 'single' || $state eq 'multiple' || die "$state ?";
1425     &cancelbug;
1426     &endmerge if $manybugs;
1427     $state= 'idle';
1428     &dlex("nochangebug");
1429 }
1430
1431 sub setbug {
1432     &dlen("setbug $ref");
1433     if ($ref =~ m/^-\d+/) {
1434         if (!defined $clonebugs{$ref}) {
1435             &notfoundbug;
1436             &dlex("setbug => noclone");
1437             return 0;
1438         }
1439         $ref = $clonebugs{$ref};
1440     }
1441     $state eq 'idle' || die "$state ?";
1442     if (!&getbug) {
1443         &notfoundbug;
1444         &dlex("setbug => 0s");
1445         return 0;
1446     }
1447
1448     if (!&checkpkglimit) {
1449         &cancelbug;
1450         return 0;
1451     }
1452
1453     @thisbugmergelist= split(/ /,$data->{mergedwith});
1454     if (!@thisbugmergelist) {
1455         &foundbug;
1456         $manybugs= 0;
1457         $state= 'single';
1458         $sref=$ref;
1459         &dlex("setbug => 1s");
1460         return 1;
1461     }
1462     &cancelbug;
1463     &getmerge;
1464     $manybugs= 1;
1465     if (!&getbug) {
1466         &notfoundbug;
1467         &endmerge;
1468         &dlex("setbug => 0mc");
1469         return 0;
1470     }
1471     &foundbug;
1472     $state= 'multiple'; $sref=$ref;
1473     &dlex("setbug => 1m");
1474     return 1;
1475 }
1476
1477 sub getnextbug {
1478     &dlen("getnextbug");
1479     $state eq 'single' || $state eq 'multiple' || die "$state ?";
1480     &savebug;
1481     if (!$manybugs || !@thisbugmergelist) {
1482         length($action) || die;
1483         print {$transcript} "$action\n$extramessage\n";
1484         &endmerge if $manybugs;
1485         $state= 'idle';
1486         &dlex("getnextbug => 0");
1487         return 0;
1488     }
1489     $ref= shift(@thisbugmergelist);
1490     &getbug || die "bug $ref disappeared";
1491     &foundbug;
1492     &dlex("getnextbug => 1");
1493     return 1;
1494 }
1495
1496 # Low-level bug-manipulation calls
1497 # Do no announcements
1498 #
1499 #    getbug (returns 0)
1500 #
1501 #    getbug (returns 1)
1502 #    cancelbug
1503 #
1504 #    getmerge
1505 #    $action= (something)
1506 #    getbug (returns 1)
1507 #    savebug/cancelbug
1508 #    getbug (returns 1)
1509 #    savebug/cancelbug
1510 #    [getbug (returns 0)]
1511 #    &transcript("$action\n\n")
1512 #    endmerge
1513
1514 sub notfoundbug { print {$transcript} "$gBug number $ref not found. (Is it archived?)\n\n"; }
1515 sub foundbug { print {$transcript} "$gBug#$ref: $data->{subject}\n"; }
1516
1517 sub getmerge {
1518     &dlen("getmerge");
1519     $mergelowstate eq 'idle' || die "$mergelowstate ?";
1520     &filelock('lock/merge');
1521     $mergelowstate='locked';
1522     &dlex("getmerge");
1523 }
1524
1525 sub endmerge {
1526     &dlen("endmerge");
1527     $mergelowstate eq 'locked' || die "$mergelowstate ?";
1528     &unfilelock;
1529     $mergelowstate='idle';
1530     &dlex("endmerge");
1531 }
1532
1533 sub getbug {
1534     &dlen("getbug $ref");
1535     $lowstate eq 'idle' || die "$state ?";
1536     # Only use unmerged bugs here
1537     if (($data = &lockreadbug($ref,'db-h'))) {
1538         $sref= $ref;
1539         $lowstate= "open";
1540         &dlex("getbug => 1");
1541         $extramessage='';
1542         return 1;
1543     }
1544     $lowstate= 'idle';
1545     &dlex("getbug => 0");
1546     return 0;
1547 }
1548
1549 sub cancelbug {
1550     &dlen("cancelbug");
1551     $lowstate eq 'open' || die "$state ?";
1552     &unfilelock;
1553     $lowstate= 'idle';
1554     &dlex("cancelbug");
1555 }
1556
1557 sub savebug {
1558     &dlen("savebug $ref");
1559     $lowstate eq 'open' || die "$lowstate ?";
1560     length($action) || die;
1561     $ref == $sref || die "read $sref but saving $ref ?";
1562     append_action_to_log(bug => $ref,
1563                          action => $action,
1564                          requester => $header{from},
1565                          request_addr => $controlrequestaddr,
1566                          message => \@log,
1567                          get_lock => 0,
1568                         );
1569     unlockwritebug($ref, $data);
1570     $lowstate= "idle";
1571     &dlex("savebug");
1572 }
1573
1574 sub dlen {
1575     return if !$dl;
1576     print {$transcript} "C> @_ ($state $lowstate $mergelowstate)\n";
1577 }
1578
1579 sub dlex {
1580     return if !$dl;
1581     print {$transcript} "R> @_ ($state $lowstate $mergelowstate)\n";
1582 }
1583
1584 sub urlsanit {
1585     my $url = shift;
1586     $url =~ s/%/%25/g;
1587     $url =~ s/\+/%2b/g;
1588     my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
1589     $url =~ s/([<>&"])/\&$saniarray{$1};/g;
1590     return $url;
1591 }
1592
1593 sub sendlynxdoc {
1594     &sendlynxdocraw;
1595     print {$transcript} "\n";
1596     $ok++;
1597 }
1598
1599 sub sendtxthelp {
1600     &sendtxthelpraw;
1601     print {$transcript} "\n";
1602     $ok++;
1603 }
1604
1605 sub sendtxthelpraw {
1606     local ($relpath,$description) = @_;
1607     $doc='';
1608     open(D,"$gDocDir/$relpath") || die "open doc file $relpath: $!";
1609     while(<D>) { $doc.=$_; }
1610     close(D);
1611     print {$transcript} "Sending $description in separate message.\n";
1612     &sendmailmessage(<<END.$doc,$replyto);
1613 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1614 To: $replyto
1615 Subject: $gProject $gBug help: $description
1616 References: $header{'message-id'}
1617 In-Reply-To: $header{'message-id'}
1618 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
1619 Precedence: bulk
1620 X-$gProject-PR-Message: doc-text $relpath
1621
1622 END
1623     $ok++;
1624 }
1625
1626 sub sendlynxdocraw {
1627     local ($relpath,$description) = @_;
1628     $doc='';
1629     open(L,"lynx -nolist -dump http://$gCGIDomain/\Q$relpath\E 2>&1 |") || die "fork for lynx: $!";
1630     while(<L>) { $doc.=$_; }
1631     $!=0; close(L);
1632     if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1633         print {$transcript} "Information ($description) is not available -\n".
1634              "perhaps the $gBug does not exist or is not on the WWW yet.\n";
1635          $ok++;
1636     } elsif ($?) {
1637         print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1638     } else {
1639         print {$transcript} "Sending $description.\n";
1640         &sendmailmessage(<<END.$doc,$replyto);
1641 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1642 To: $replyto
1643 Subject: $gProject $gBugs information: $description
1644 References: $header{'message-id'}
1645 In-Reply-To: $header{'message-id'}
1646 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1647 Precedence: bulk
1648 X-$gProject-PR-Message: doc-html $relpath
1649
1650 END
1651          $ok++;
1652     }
1653 }
1654
1655 sub addrecipient {
1656      my %param = validate_width(params => \@_,
1657                                 spec => {recipients => {type => HASHREF,
1658                                                        },
1659                                          bug_num    => {type => SCALAR,
1660                                                         regex => qr/^\d*$/,
1661                                                         default => '',
1662                                                        },
1663                                          reason     => {type => SCALAR,
1664                                                         default => '',
1665                                                        },
1666                                          address    => {type => SCALAR|ARRAYREF,
1667                                                        },
1668                                          type       => {type => SCALAR,
1669                                                         default => 'cc',
1670                                                         regex   => qr/^b?cc/i,
1671                                                        },
1672                                         },
1673                                )
1674      for my $addr (make_list($param{address})) {
1675           if (lc($param{type}) eq 'bcc' and
1676               exists $param{recipients}{$addr}{$param{reason}}{$param{bug_num}}
1677              ) {
1678                next;
1679           }
1680           $param{recipients}{$addr}{$param{reason}}{$param{bug_num}} = $param{type};
1681      }
1682 }
1683
1684 sub addmaintainers {
1685     # Data structure is:
1686     #   maintainer email address &c -> assoc of packages -> assoc of bug#'s
1687     my %param = validate_with(params => \@_,
1688                               spec   => {data => {type => HASHREF,
1689                                                  },
1690                                          recipients => {type => HASHREF,
1691                                                        },
1692                                         }
1693                              );
1694     my ($p, $addmaint);
1695     my $anymaintfound=0; my $anymaintnotfound=0;
1696     for my $p (splitpackages($param{data}{package})) {
1697         $p =~ y/A-Z/a-z/;
1698         $p =~ /([a-z0-9.+-]+)/;
1699         $p = $1;
1700         next unless defined $p;
1701         if (defined $config{subscription_domain}) {
1702              my @source_packages = binarytosource($p);
1703              if (@source_packages) {
1704                   for my $source (@source_packages) {
1705                        add_recipients(recipients => $param{recipients},
1706                                       addrs => "$source\@".$config{subscription_domain},
1707                                       type  => 'bcc',
1708                                      );
1709                   }
1710              }
1711              else {
1712                   add_recipients(recipients => $param{recipients},
1713                                  addrs => "$p\@".$config{subscription_domain},
1714                                  type  => 'bcc',
1715                                 );
1716              }
1717         }
1718         if (defined $param{data}{severity} and defined $config{strong_list} and
1719                 isstrongseverity($param{data}{severity})) {
1720             add_recipients(recipients => $param{recipients},
1721                                       addrs => "$config{strong_list}\@".$config{list_domain},
1722                                       type  => 'bcc',
1723                                      );
1724         }
1725         if (defined(getmaintainers->{$p})) {
1726             $addmaint= getmaintainers->{$p};
1727             print {$transcript} "MR|$addmaint|$p|$ref|\n" if $dl>2;
1728             add_recipients(recipients => $param{recipients},
1729                            addrs => $addmaint,
1730                            reason => $p,
1731                            bug_num => $param{data}{bug_num},
1732                            type  => 'cc',
1733                           );
1734             print "maintainer add >$p|$addmaint<\n" if $debug;
1735         } else {
1736             print "maintainer none >$p<\n" if $debug;
1737             print {$transcript} "Warning: Unknown package '$p'\n";
1738             print {$transcript} "MR|unknown-package|$p|$ref|\n" if $dl>2;
1739             add_recipients(recipients => $param{recipients},
1740                            addrs => $config{unknown_maintainer_email},
1741                            reason => $p,
1742                            bug_num => $param{data}{bug_num},
1743                            type  => 'cc',
1744                           )
1745                  if defined $config{unknown_maintainer_email} and
1746                       length $config{unknown_maintainer_email};
1747         }
1748     }
1749
1750     if (length $param{data}{owner}) {
1751         $addmaint = $param{data}{owner};
1752         print {$transcript} "MO|$addmaint|$param{data}{package}|$ref|\n" if $dl>2;
1753         add_recipients(recipients => $param{recipients},
1754                        addrs => $addmaint,
1755                        reason => $p,
1756                        bug_num => $param{data}{bug_num},
1757                        type  => 'cc',
1758                       );
1759         print "owner add >$param{data}{package}|$addmaint<\n" if $debug;
1760     }
1761 }
1762
1763
1764 sub sendinfo {
1765     local ($wherefrom,$path,$description) = @_;
1766     if ($wherefrom eq "ftp.d.o") {
1767       $doc = `lynx -nolist -dump http://ftp.debian.org/debian/indices/$path.gz 2>&1 | gunzip -cf` or die "fork for lynx/gunzip: $!";
1768       $! = 0;
1769       if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
1770           print {$transcript} "$description is not available.\n";
1771           $ok++; return;
1772       } elsif ($?) {
1773           print {$transcript} "Error getting $description (code $? $!):\n$doc\n";
1774           return;
1775       }
1776     } elsif ($wherefrom eq "local") {
1777       open P, "$path";
1778       $doc = do { local $/; <P> };
1779       close P;
1780     } else {
1781       print {$transcript} "internal errror: info files location unknown.\n";
1782       $ok++; return;
1783     }
1784     print {$transcript} "Sending $description.\n";
1785     &sendmailmessage(<<END.$doc,$replyto);
1786 From: $gMaintainerEmail ($gProject $gBug Tracking System)
1787 To: $replyto
1788 Subject: $gProject $gBugs information: $description
1789 References: $header{'message-id'}
1790 In-Reply-To: $header{'message-id'}
1791 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
1792 Precedence: bulk
1793 X-$gProject-PR-Message: getinfo
1794
1795 $description follows:
1796
1797 END
1798     $ok++;
1799     print {$transcript} "\n";
1800 }