scripts/service.in

   1 #!/usr/bin/perl
   2 # $Id: service.in,v 1.2 1999/09/02 22:27:29 gecko Exp $
   3 #
   4 # Usage: service <code>.nn
   5 # Temps:  incoming/P<code>.nn
   6
   7 use Mail::Address;
   8 require('/etc/debbugs/config');
   9 require('/usr/lib/debbugs/errorlib');
  10 $ENV{'PATH'}= '/usr/lib/debbugs'.$ENV{'PATH'};;
  11 chdir("$gSpoolDir") || die "chdir spool: $!\n";
  12
  13 # open(DEBUG,">&4");
  14
  15 $wwwbase= "$gWebDir";
  16
  17 # defined($intdate= time) || &quit("failed to get time: $!");
  18
  19 $_=shift;
  20 m/^[RC]\.\d+$/ || &quit("bad argument");
  21 $control= m/C/;
  22 $nn= $_;
  23 if (!rename("incoming/G$nn","incoming/P$nn")) {
  24     $_=$!.'';  m/no such file or directory/i && exit 0;
  25     &quit("renaming to lock: $!");
  26 }
  27
  28 open(M,"incoming/P$nn");
  29 @log=<M>;
  30 @msg=@log;
  31 close(M);
  32
  33 grep((s/\n$//,s/\s+$//),@msg);
  34
  35 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
  36
  37 chop($tdate= `date -u '+%a, %d %h 19%y %T GMT'`);
  38 $fwd= <<END;
  39 Received: via spool for service; $tdate
  40 END
  41
  42 for ($i=0; $i<=$#msg; $i++) {
  43     $_ = $msg[$i];
  44     last unless length($_);
  45     $fwd .= $_."\n";
  46     while ($msg[$i+1] =~ m/^\s/) {
  47         $i++;
  48         $fwd .= $msg[$i]."\n" if $ins; # Huh ? Where is ins set ?
  49         $_ .= ' '.$msg[$i];
  50     }
  51 # print DEBUG ">$_<\n";
  52     if (s/^(\S+):\s*//) {
  53         $v= $1; $v =~ y/A-Z/a-z/;
  54 print DEBUG ">$v=$_<\n";
  55         $header{$v}= $_;
  56     } else {
  57 print DEBUG "!>$_<\n";
  58     }
  59 }
  60
  61 defined($header{'from'}) || &quit("no From header");
  62 $replyto= defined($header{'reply-to'}) ? $header{'reply-to'} : $header{'from'};
  63
  64 $controlrequestaddr= $control ? "control\@$gEmailDomain" : "request\@$gEmailDomain";
  65 $transcript='';
  66 &transcript("Processing commands for $controlrequestaddr:\n\n");
  67
  68 $dl= 0;
  69 $state= 'idle';
  70 $lowstate= 'idle';
  71 $mergelowstate= 'idle';
  72 $midix=0;
  73
  74 for ($procline=$i; $procline<=$#msg; $procline++) {
  75     $state eq 'idle' || "$state ?";
  76     $lowstate eq 'idle' || "$lowstate ?";
  77     $mergelowstate eq 'idle' || "$mergelowstate ?";
  78     $_= $msg[$procline]; s/\s+$//;
  79     next unless m/\S/; next if m/^\s*\#/;
  80     &transcript("> $_\n");
  81     $action= '';
  82     if (m/^stop$/ || m/^quit$/ || m/^--/ || m/^thank/) {
  83         &transcript("Stopping processing here.\n\n");
  84         last;
  85     } elsif (m/^debug\s+(\d+)$/ && $1 >= 0 && $1 <= 1000) {
  86         $dl= $1+0;
  87         &transcript("Debug level $dl.\n\n");
  88     } elsif (m/^(send|get)\s+\#?(\d{3,})$/) {
  89         $ref= $2+0; $reffile= $ref; $reffile =~ s,^..,$&/$&,;
  90         &sendlynxdoc("db/$reffile.html","logs for $gBug#$ref");
  91     } elsif (m/^send-detail\s+\#?(\d+)$/) {
  92         $ref= $1+0; $reffile= $ref; $reffile =~ s,^..,$&/$&,;
  93         &sendlynxdoc("db/$reffile-b.html","additional logs for $gBug#$ref");
  94     } elsif (m/^index(\s+full)?$/) {
  95         &sendlynxdoc("db/ix/full.html",'full index');
  96     } elsif (m/^index-summary\s+by-package$/) {
  97         &sendlynxdoc("db/ix/psummary.html",'summary index sorted by package/title');
  98     } elsif (m/^index-summary(\s+by-number)?$/) {
  99         &sendlynxdoc("db/ix/summary.html",'summary index sorted by number/date');
 100     } elsif (m/^index(\s+|-)pack(age)?s?$/) {
 101         &sendlynxdoc("db/ix/packages.html",'index of packages');
 102     } elsif (m/^index(\s+|-)maints?$/) {
 103         &sendlynxdoc("db/ix/maintainers.html",'index of maintainers');
 104     } elsif (m/^index(\s+|-)maint\s+(\S.*\S)$/) {
 105         $substrg= $2; $matches=0;
 106         opendir(DBD,"$gWebDir/db/ma") || die $!;
 107         while (defined($_=readdir(DBD))) {
 108             next unless m/^l/ && m/\.html$/;
 109             &transcript("F|$_\n") if $dl>1;
 110             $filename= $_; s/^l//; s/\.html$//;
 111             &transcript("P|$_\n") if $dl>2;
 112             while (s/-(..)([^_])/-$1_-$2/) { }
 113             &transcript("P|$_\n") if $dl>2;
 114             s/^(.{0,2})_/$1-20_/g; while (s/([^-]..)_/$1-20_/) { };
 115             &transcript("P|$_\n") if $dl>2;
 116             s/^,(.*),(.*),([^,]+)$/$1-40_$2-20_-28_$3-29_/;
 117             &transcript("P|$_\n") if $dl>2;
 118             s/^([^,]+),(.*),(.*),$/$1-20_-3c_$2-40_$3-3e_/;
 119             &transcript("P|$_\n") if $dl>2;
 120             s/\./-2e_/g;
 121             &transcript("P|$_\n") if $dl>2;
 122             $out='';
 123             while (m/-(..)_/) { $out.= $`.sprintf("%c",hex($1)); $_=$'; }
 124             $out.=$_;
 125             &transcript("M|$out\n") if $dl>1;
 126             next unless index(lc $out, lc $substrg)>=0;
 127             &transcript("S|$filename\n") if $dl>0;
 128             &transcript("S|$out\n") if $dl>0;
 129             $matches++;
 130             &sendlynxdocraw("db/ma/$filename","$gBug list for maintainer \`$out'");
 131         }
 132         if ($matches) {
 133             &transcript("$gBug list(s) for $matches maintainer(s) sent.\n\n");
 134         } else {
 135             &transcript("No maintainers found containing \`$substrg'.\n".
 136                         "Use \`index-maint' to get list of maintainers.\n\n");
 137         }
 138         $ok++;
 139     } elsif (m/^index(\s+|-)pack(age)?s?\s+(\S.*\S)$/) {
 140         $substrg= $+; $matches=0;
 141         opendir(DBD,"$gWebDir/db/pa") || die $!;
 142         while (defined($_=readdir(DBD))) {
 143             next unless m/^l/ && m/\.html$/;
 144             &transcript("F|$_\n") if $dl>1;
 145             $filename= $_; s/^l//; s/\.html$//;
 146             next unless index(lc $_, lc $substrg)>=0;
 147             &transcript("S|$filename\n") if $dl>0;
 148             &transcript("S|$out\n") if $dl>0;
 149             $matches++;
 150             &sendlynxdocraw("db/pa/$filename","$gBug list for package \`$_'");
 151         }
 152         if ($matches) {
 153             &transcript("$gBug list(s) for $matches package(s) sent.\n\n");
 154         } else {
 155             &transcript("No packages found containing \`$substrg'.\n".
 156                         "Use \`index-packages' to get list of packages.\n\n");
 157         }
 158         $ok++;
 159     } elsif (m/^send-unmatched(\s+this|\s+-?0)?$/) {
 160         &sendlynxdoc("db/ju/unmatched-1.html","junk (this week)");
 161     } elsif (m/^send-unmatched\s+(last|-1)$/) {
 162         &sendlynxdoc("db/ju/unmatched-2.html","junk (last week)");
 163     } elsif (m/^send-unmatched\s+(old|-2)$/) {
 164         &sendlynxdoc("db/ju/unmatched-3.html","junk (two weeks ago)");
 165     } elsif (m/^getinfo\s+(\S+)$/) {
 166         $file= $1;
 167         if ($file =~ m/^\./ || $file !~ m/^[-.0-9a-z]+$/ || $file =~ m/\.gz$/) {
 168             &transcript("Filename $file is badly formatted.\n\n");
 169         } elsif (open(P,"$gDocDir/$file")) {
 170             $ok++;
 171             &transcript("Info file $file appears below.\n\n");
 172             $extras.= "\n---------- Info file $file follows:\n\n";
 173             while(<P>) { $extras.= $_; }
 174             close(P);
 175         } else {
 176             &transcript("Info file $file does not exist.\n\n");
 177          }
 178     } elsif (m/^help$/) {
 179         &sendhelp;
 180         &transcript("\n");
 181         $ok++;
 182     } elsif (m/^refcard$/) {
 183         &sendtxthelp("bug-mailserver-refcard.txt","mailservers' reference card");
 184     } elsif (m/^subscribe/) {
 185         &transcript(<<END);
 186 There is no $gProject $gBug mailing list.  If you wish to review bug reports
 187 please do so via http://$gWebUrl/ or ask this mailserver
 188 to send them to you.
 189 soon: MAILINGLISTS_TEXT
 190 END
 191     } elsif (m/^unsubscribe/) {
 192         &transcript(<<END);
 193 soon: UNSUBSCRIBE_TEXT
 194 soon: MAILINGLISTS_TEXT
 195 END
 196     } elsif (!$control) {
 197         &transcript(<<END);
 198 Unknown command or malformed arguments to command.
 199 (Use control\@$gEmailDomain to manipulate reports.)
 200
 201 END
 202         if (++$unknowns >= 3) {
 203             &transcript("Too many unknown commands, stopping here.\n\n");
 204             last;
 205         }
 206     } elsif (m/^close\s+\#?(\d+)$/) {
 207         $ok++;
 208         $ref= $1;
 209         if (&setbug) {
 210             if (length($s_done)) {
 211                 &transcript("$gBug is already closed, cannot re-close.\n\n");
 212                 &nochangebug;
 213             } else {
 214                 $action= "$gBug closed, ack sent to submitter - they'd better know why !";
 215                 do {
 216                     &addmaintainers($s_package);
 217                                         if ( length( $gDoneList ) > 0 && length( $gListDomain ) >
 218                                         0 ) { &addccaddress("$gDoneList\@$gListDomain"); }
 219                     $s_done= $replyto;
 220                     $message= <<END;
 221 From: $gMaintainerEmail ($gMaintainer)
 222 To: $s_originator
 223 Subject: $gBug#$ref acknowledged by developer
 224          ($s_subject)
 225 References: $header{'message-id'} $s_msgid
 226 In-Reply-To: $s_msgid
 227 Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
 228
 229 This is an automatic notification regarding your $gBug report.
 230
 231 It has been marked as closed by one of the developers, namely
 232 $replyto.
 233
 234 You should be hearing from them with a substantive response shortly,
 235 if you have not already done so.  If not, please contact them
 236 directly, or email DB_SUBMIT_ADDRPQ or myself.
 237
 238 $gMaintainer
 239 (administrator, $gProject $gBugs database)
 240 END
 241                     &sendmailmessage($message,$s_originator);
 242                 } while (&getnextbug);
 243             }
 244         }
 245     } elsif (m/^reassign\s+\#?(\d+)\s+(\S.*\S)$/) {
 246         $ok++;
 247         $ref= $1; $newpackage= $2;
 248         if (&setbug) {
 249             if (length($s_package)) {
 250                 $action= "$gBug reassigned from package \`$s_package'".
 251                          " to \`$newpackage'.";
 252             } else {
 253                 $action= "$gBug assigned to package \`$newpackage'.";
 254             }
 255             do {
 256                 &addmaintainers($s_package);
 257                 &addmaintainers($newpackage);
 258                 $s_package= $newpackage;
 259             } while (&getnextbug);
 260         }
 261     } elsif (m/^reopen\s+\#?(\d+)$/ ? ($noriginator='', 1) :
 262              m/^reopen\s+\#?(\d+)\s+\=$/ ? ($noriginator='', 1) :
 263              m/^reopen\s+\#?(\d+)\s+\!$/ ? ($noriginator=$replyto, 1) :
 264              m/^reopen\s+\#?(\d+)\s+(\S.*\S)$/ ? ($noriginator=$2, 1) : 0) {
 265         $ok++;
 266         $ref= $1;
 267         if (&setbug) {
 268             if (!length($s_done)) {
 269                 &transcript("$gByg is already open, cannot reopen.\n\n");
 270                 &nochangebug;
 271             } else {
 272                 $action=
 273                     $noriginator eq '' ? "$gBug reopened, originator not changed." :
 274                         "$gBug reopened, originator set to $noriginator.";
 275                 do {
 276                     &addmaintainers($s_package);
 277                     $s_originator= $noriginator eq '' ?  $s_originator : $noriginator;
 278                     $s_done= '';
 279                 } while (&getnextbug);
 280             }
 281         }
 282     } elsif (m/^forwarded\s+\#?(\d+)\s+(\S.*\S)$/) {
 283         $ok++;
 284         $ref= $1; $whereto= $2;
 285         if (&setbug) {
 286             if (length($s_forwarded)) {
 287     $action= "Forwarded-to-address changed from $s_forwarded to $whereto.";
 288             } else {
 289     $action= "Noted your statement that $gBug has been forwarded to $whereto.";
 290             }
 291             if (length($s_done)) {
 292                 $extramessage= "(By the way, this $gBug is currently marked as done.)\n";
 293             }
 294             do {
 295                 &addmaintainers($s_package);
 296                                 if (length($gFowardList)>0 && length($gListDomain)>0 )
 297                 { &addccaddress("$gFowardList\@$gListDomain"); }
 298                 $s_forwarded= $whereto;
 299             } while (&getnextbug);
 300         }
 301     } elsif (m/^notforwarded\s+\#?(\d+)$/) {
 302         $ok++;
 303         $ref= $1;
 304         if (&setbug) {
 305             if (!length($s_forwarded)) {
 306                 &transcript("$gBug is not marked as having been forwarded.\n\n");
 307                 &nochangebug;
 308             } else {
 309     $action= "Removed annotation that $gBug had been forwarded to $s_forwarded.";
 310                 do {
 311                     &addmaintainers($s_package);
 312                     $s_forwarded= '';
 313                 } while (&getnextbug);
 314             }
 315         }
 316     } elsif (m/^severity\s+\#?(\d+)\s+([-0-9a-z]+)$/) {
 317         $ok++;
 318         $ref= $1;
 319         $newseverity= $2;
 320         if (!grep($_ eq $newseverity, @severities, "$gDefaultSeverity")) {
 321             &transcript("Severity level \`$newseverity' is not known.\n".
 322                         "Recognised are: ".join(' ',@showseverities).".\n\n");
 323         } elsif (&setbug) {
 324             $printseverity= $s_severity;
 325             $printseverity= "$gDefaultSeverity" if $printseverity eq '';
 326             $action= "Severity set to \`$newseverity'.";
 327             do {
 328                 &addmaintainers($s_package);
 329                 $s_severity= $newseverity;
 330             } while (&getnextbug);
 331         }
 332     } elsif (m/^retitle\s+\#?(\d+)\s+(\S.*\S)\s*$/) {
 333         $ok++;
 334         $ref= $1; $newtitle= $2;
 335         if (&getbug) {
 336             &foundbug;
 337             &addmaintainers($s_package);
 338             $s_subject= $newtitle;
 339             $action= "Changed $gBug title.";
 340             &savebug;
 341             &transcript("$action\n");
 342             if (length($s_done)) {
 343                 &transcript("(By the way, that $gBug is currently marked as done.)\n");
 344             }
 345             &transcript("\n");
 346         } else {
 347             &notfoundbug;
 348         }
 349     } elsif (m/^unmerge\s+\#?(\d+)$/) {
 350         $ok++;
 351         $ref= $1;
 352         if (&setbug) {
 353             if (!length($s_mergedwith)) {
 354                 &transcript("$gBug is not marked as being merged with any others.\n\n");
 355                 &nochangebug;
 356             } else {
 357                 $mergelowstate eq 'locked' || die "$mergelowstate ?";
 358                 $action= "Disconnected #$ref from all other report(s).";
 359                 @newmergelist= split(/ /,$s_mergedwith);
 360                 $discref= $ref;
 361                 do {
 362                     &addmaintainers($s_package);
 363                     $s_mergedwith= ($ref == $discref) ? ''
 364                         : join(' ',grep($_ ne $ref,@newmergelist));
 365                 } while (&getnextbug);
 366             }
 367         }
 368     } elsif (m/^merge\s(\d+(\s+\d+)+)\s*$/) {
 369         $ok++;
 370         @tomerge= sort { $a <=> $b } split(/\s+/,$1);
 371         @newmergelist= ();
 372         &getmerge;
 373         while (defined($ref= shift(@tomerge))) {
 374             &transcript("D| checking merge $ref\n") if $dl;
 375             $ref+= 0;
 376             next if grep($_ eq $ref,@newmergelist);
 377             if (!&getbug) { &notfoundbug; @newmergelist=(); last }
 378             &foundbug;
 379             &transcript("D| adding $ref ($s_mergewith)\n") if $dl;
 380             $mismatch= '';
 381             &checkmatch('package','m_package',$s_package);
 382             &checkmatch('forwarded addr','m_forwarded',$s_forwarded);
 383             &checkmatch('severity','m_severity',$s_severity);
 384             &checkmatch('done mark','m_done',length($s_done) ? 'done' : 'open');
 385             if (length($mismatch)) {
 386                 &transcript("Mismatch - only $Bugs in same state can be merged:\n".
 387                             $mismatch."\n");
 388                 &cancelbug; @newmergelist=(); last;
 389             }
 390             push(@newmergelist,$ref);
 391             push(@tomerge,split(/ /,$s_mergedwith));
 392             &cancelbug;
 393         }
 394         if (@newmergelist) {
 395             @newmergelist= sort { $a <=> $b } @newmergelist;
 396             $action= "Merged @newmergelist.";
 397             for $ref (@newmergelist) {
 398                 &getbug || die "huh ?  $gBug $ref disappeared during merge";
 399                 &addmaintainers($s_package);
 400                 $s_mergedwith= join(' ',grep($_ ne $ref,@newmergelist));
 401                 &savebug;
 402             }
 403             &transcript("$action\n\n");
 404         }
 405         &endmerge;
 406     } else {
 407         &transcript("Unknown command or malformed arguments to command.\n\n");
 408         if (++$unknowns >= 5) {
 409             &transcript("Too many unknown commands, stopping here.\n\n");
 410             last;
 411         }
 412     }
 413 }
 414 if ($procline>$#msg) {
 415     &transcript(">\nEnd of message, stopping processing here.\n\n");
 416 }
 417 if (!$ok) {
 418     &transcript("No commands successfully parsed; sending the help text(s).\n");
 419     &sendhelp;
 420     &transcript("\n");
 421 }
 422
 423 &transcript("MC\n") if $dl>1;
 424 @maintccs= ();
 425 for $maint (keys %maintccreasons) {
 426 &transcript("MM|$maint|\n") if $dl>1;
 427     next if $maint eq $replyto;
 428     $reasonstring= '';
 429     $reasonsref= $maintccreasons{$maint};
 430 &transcript("MY|$maint|\n") if $dl>2;
 431     for $p (sort keys %$reasonsref) {
 432 &transcript("MP|$p|\n") if $dl>2;
 433         $reasonstring.= ', ' if length($reasonstring);
 434         $reasonstring.= $p.' ' if length($p);
 435         $reasonstring.= join(' ',map("#$_",sort keys %{$$reasonsref{$p}}));
 436     }
 437     push(@maintccs,"$maint ($reasonstring)");
 438     push(@maintccaddrs,"$maint");
 439 }
 440 if (@maintccs) {
 441     &transcript("MC|@maintccs|\n") if $dl>2;
 442     $maintccs= "Cc: ".join(",\n    ",@maintccs)."\n";
 443 }
 444
 445 $reply= <<END;
 446 From: $gMaintainerEmail ($gMaintainer)
 447 To: $replyto
 448 ${maintccs}Subject: Processed: $header{'subject'}
 449 In-Reply-To: $header{'message-id'}
 450 References: $header{'message-id'}
 451 Message-ID: <handler.s.$nn.transcript\@$gEmailDomain>
 452
 453 ${transcript}Please contact me if you need assistance.
 454
 455 $gMaintainer
 456 (administrator, $gProject $gBugs database)
 457 $extras
 458 END
 459
 460 $repliedshow= join(', ',$replyto,@maintccaddrs);
 461 &filelock("lock/-1");
 462 open(AP,">>db/-1.log") || &quit("open db/-1.log: $!");
 463 print(AP
 464       "\2\n$repliedshow\n\5\n$reply\n\3\n".
 465       "\6\n".
 466       "<strong>Request received</strong> from <code>".
 467       &sani($header{'from'})."</code>\n".
 468       "to <code>".&sani($controlrequestaddr)."</code>\n".
 469       "\3\n".
 470       "\7\n",@log,"\n\3\n") || &quit("writing db/-1.log: $!");
 471 close(AP) || &quit("open db/-1.log: $!");
 472 &unfilelock;
 473 utime(time,time,"db");
 474
 475 &sendmailmessage($reply,$replyto,@maintccaddrs);
 476
 477 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
 478
 479 sub get_addresses {
 480     return
 481        map { $_->address() }
 482        map { Mail::Address->parse($_) } @_;
 483 }
 484
 485 sub sendmailmessage {
 486     local ($message,@recips) = @_;
 487     print DEBUG "mailing to >@recips<\n";
 488     $c= open(D,"|-");
 489     defined($c) || &quit("mailing forking for sendmail: $!");
 490     if (!$c) { # ie, we are the child process
 491         exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odi','-oem','-oi',get_addresses(@recips);
 492         die $!;
 493     }
 494     print(D $message) || &quit("writing to sendmail process: $!");
 495     $!=0; close(D); $? && &quit("sendmail gave exit status $? ($!)");
 496     $midix++;
 497 }
 498
 499 sub sendhelp {
 500         &sendtxthelpraw("bug-log-mailserver.txt","instructions for request\@$gEmailDomain");
 501         &sendtxthelpraw("bug-maint-mailcontrol.txt","instructions for control\@$gEmailDomain")
 502             if $control;
 503 }
 504
 505 #sub unimplemented {
 506 #    &transcript("Sorry, command $_[0] not yet implemented.\n\n");
 507 #}
 508
 509 sub checkmatch {
 510     local ($string,$mvarname,$svarvalue) = @_;
 511     local ($mvarvalue);
 512     if (@newmergelist) {
 513         eval "\$mvarvalue= \$$mvarname";
 514         &transcript("D| checkmatch \`$string' /$mvarname/$mvarvalue/$svarvalue/\n")
 515             if $dl;
 516         $mismatch .=
 517             "Values for \`$string' don't match:\n".
 518             " #$newmergelist[0] has \`$mvarvalue';\n".
 519             " #$ref has \`$svarvalue'\n"
 520             if $mvarvalue ne $svarvalue;
 521     } else {
 522         &transcript("D| setupmatch \`$string' /$mvarname/$svarvalue/\n")
 523             if $dl;
 524         eval "\$$mvarname= \$svarvalue";
 525     }
 526 }
 527
 528 # High-level bug manipulation calls
 529 # Do announcements themselves
 530 #
 531 # Possible calling sequences:
 532 #    setbug (returns 0)
 533 #
 534 #    setbug (returns 1)
 535 #    &transcript(something)
 536 #    nochangebug
 537 #
 538 #    setbug (returns 1)
 539 #    $action= (something)
 540 #    do {
 541 #      (modify s_* variables)
 542 #    } while (getnextbug);
 543
 544 sub nochangebug {
 545     &dlen("nochangebug");
 546     $state eq 'single' || $state eq 'multiple' || die "$state ?";
 547     &cancelbug;
 548     &endmerge if $manybugs;
 549     $state= 'idle';
 550     &dlex("nochangebug");
 551 }
 552
 553 sub setbug {
 554     &dlen("setbug $ref");
 555     $state eq 'idle' || die "$state ?";
 556     if (!&getbug) {
 557         &notfoundbug;
 558         &dlex("setbug => 0s");
 559         return 0;
 560     }
 561     @thisbugmergelist= split(/ /,$s_mergedwith);
 562     if (!@thisbugmergelist) {
 563         &foundbug;
 564         $manybugs= 0;
 565         $state= 'single';
 566         $sref=$ref;
 567         &dlex("setbug => 1s");
 568         return 1;
 569     }
 570     &cancelbug;
 571     &getmerge;
 572     $manybugs= 1;
 573     if (!&getbug) {
 574         &notfoundbug;
 575         &endmerge;
 576         &dlex("setbug => 0mc");
 577         return 0;
 578     }
 579     &foundbug;
 580     $state= 'multiple'; $sref=$ref;
 581     &dlex("setbug => 1m");
 582     return 1;
 583 }
 584
 585 sub getnextbug {
 586     &dlen("getnextbug");
 587     $state eq 'single' || $state eq 'multiple' || die "$state ?";
 588     &savebug;
 589     if (!$manybugs || !@thisbugmergelist) {
 590         length($action) || die;
 591         &transcript("$action\n$extramessage\n");
 592         &endmerge if $manybugs;
 593         $state= 'idle';
 594         &dlex("getnextbug => 0");
 595         return 0;
 596     }
 597     $ref= shift(@thisbugmergelist);
 598     &getbug || die "bug $ref disappeared";
 599     &foundbug;
 600     &dlex("getnextbug => 1");
 601     return 1;
 602 }
 603
 604 # Low-level bug-manipulation calls
 605 # Do no announcements
 606 #
 607 #    getbug (returns 0)
 608 #
 609 #    getbug (returns 1)
 610 #    cancelbug
 611 #
 612 #    getmerge
 613 #    $action= (something)
 614 #    getbug (returns 1)
 615 #    savebug/cancelbug
 616 #    getbug (returns 1)
 617 #    savebug/cancelbug
 618 #    [getbug (returns 0)]
 619 #    &transcript("$action\n\n")
 620 #    endmerge
 621
 622 sub notfoundbug { &transcript("$gBug number $ref not found.\n\n"); }
 623 sub foundbug { &transcript("$gBug#$ref: $s_subject\n"); }
 624
 625 sub getmerge {
 626     &dlen("getmerge");
 627     $mergelowstate eq 'idle' || die "$mergelowstate ?";
 628     &filelock('lock/merge');
 629     $mergelowstate='locked';
 630     &dlex("getmerge");
 631 }
 632
 633 sub endmerge {
 634     &dlen("endmerge");
 635     $mergelowstate eq 'locked' || die "$mergelowstate ?";
 636     &unfilelock;
 637     $mergelowstate='idle';
 638     &dlex("endmerge");
 639 }
 640
 641 sub getbug {
 642     &dlen("getbug $ref");
 643     $lowstate eq 'idle' || die "$state ?";
 644     if (&lockreadbug($ref)) {
 645         $sref= $ref;
 646         $lowstate= "open";
 647         &dlex("getbug => 1");
 648         $extramessage='';
 649         return 1;
 650     }
 651     $lowstate= 'idle';
 652     &dlex("getbug => 0");
 653     return 0;
 654 }
 655
 656 sub cancelbug {
 657     &dlen("cancelbug");
 658     $lowstate eq 'open' || die "$state ?";
 659     &unfilelock;
 660     $lowstate= 'idle';
 661     &dlex("cancelbug");
 662 }
 663
 664 sub savebug {
 665     &dlen("savebug $ref");
 666     $lowstate eq 'open' || die "$lowstate ?";
 667     length($action) || die;
 668     $ref == $sref || die "read $sref but saving $ref ?";
 669     open(L,">>db/$ref.log") || &quit("opening db/$ref.log: $!");
 670     print(L
 671           "\6\n".
 672           "<strong>".&sani($action)."</strong>\n".
 673           "Request was from <code>".&sani($header{'from'})."</code>\n".
 674           "to <code>".&sani($controlrequestaddr)."</code>. \n".
 675           "\3\n".
 676           "\7\n",@log,"\n\3\n") || &quit("writing db/$ref.log: $!");
 677     close(L) || &quit("closing db/$ref.log: $!");
 678     open(S,">db/$ref.status.new") || &quit("opening db/$ref.status.new: $!");
 679     print(S
 680           "$s_originator\n".
 681           "$s_date\n".
 682           "$s_subject\n".
 683           "$s_msgid\n".
 684           "$s_package\n".
 685           "$s_keywords\n".
 686           "$s_done\n".
 687           "$s_forwarded\n".
 688           "$s_mergedwith\n".
 689           "$s_severity\n") || &quit("writing db/$ref.status.new: $!");
 690     close(S) || &quit("closing db/$ref.status.new: $!");
 691     rename("db/$ref.status.new","db/$ref.status") ||
 692         &quit("installing new db/$ref.status: $!");
 693     &unfilelock;
 694     $lowstate= "idle";
 695     &dlex("savebug");
 696 }
 697
 698 sub dlen {
 699     return if !$dl;
 700     &transcript("C> @_ ($state $lowstate $mergelowstate)\n");
 701 }
 702
 703 sub dlex {
 704     return if !$dl;
 705     &transcript("R> @_ ($state $lowstate $mergelowstate)\n");
 706 }
 707
 708 sub transcript {
 709     print(DEBUG $_[0]);
 710     $transcript.= $_[0];
 711 }
 712
 713 sub sendlynxdoc {
 714     &sendlynxdocraw;
 715     &transcript("\n");
 716     $ok++;
 717 }
 718
 719 sub sendtxthelp {
 720     &sendtxthelpraw;
 721     &transcript("\n");
 722     $ok++;
 723 }
 724
 725 sub sendtxthelpraw {
 726     local ($relpath,$description) = @_;
 727     $doc='';
 728     open(D,"$gDocDir/$relpath") || &quit("open doc file $relpath: $!");
 729     while(<D>) { $doc.=$_; }
 730     close(D);
 731     &transcript("Sending $description in separate message.\n");
 732     &sendmailmessage(<<END.$doc,$replyto);
 733 From: $gMaintainerEmail ($gMaintainer)
 734 To: $replyto
 735 Subject: $gProject $gBug help: $description
 736 References: $header{'message-id'}
 737 In-Reply-To: $header{'message-id'}
 738 Message-ID: <handler.s.$nn.help.$midix\@$gEmailDomain>
 739
 740 END
 741     $ok++;
 742 }
 743
 744 sub sendlynxdocraw {
 745     local ($relpath,$description) = @_;
 746     $doc='';
 747     open(L,"lynx -nolist -dump $wwwbase/$relpath 2>&1 |") || &quit("fork for lynx: $!");
 748     while(<L>) { $doc.=$_; }
 749     $!=0; close(L);
 750     if ($? == 255 && $doc =~ m/^\n*lynx: Can\'t access start file/) {
 751         &transcript("Information ($description) is not available -\n".
 752                     "perhaps the $gBug does not exist or is not on the WWW yet.\n");
 753          $ok++;
 754     } elsif ($?) {
 755         &transcript("Error getting $description (code $? $!):\n$doc\n");
 756     } else {
 757         &transcript("Sending $description.\n");
 758         &sendmailmessage(<<END.$doc,$replyto);
 759 From: $gMaintainerEmail ($gMaintainer)
 760 To: $replyto
 761 Subject: $gProject $gBugs information: $description
 762 References: $header{'message-id'}
 763 In-Reply-To: $header{'message-id'}
 764 Message-ID: <handler.s.$nn.info.$midix\@$gEmailDomain>
 765
 766 END
 767          $ok++;
 768     }
 769 }
 770
 771 sub addccaddress {
 772     my ($cca) = @_;
 773     $maintccreasons{$cca}{''}{$ref}= 1;
 774 }
 775
 776 sub addmaintainers {
 777     # Data structure is:
 778     #   maintainer email address &c -> assoc of packages -> assoc of bug#'s
 779     my $p, $addmaint, $pshow;
 780     &ensuremaintainersloaded;
 781     $anymaintfound=0; $anymaintnotfound=0;
 782     for $p (split(m/[ \t?,()]+/,$_[0])) {
 783         $p =~ y/A-Z/a-z/;
 784         $pshow= ($p =~ m/[-+.a-z0-9]+/ ? $& : '');
 785         if (defined($maintainerof{$p})) {
 786             $addmaint= $maintainerof{$p};
 787 &transcript("MR|$addmaint|$p|$ref|\n") if $dl>2;
 788             $maintccreasons{$addmaint}{$p}{$ref}= 1;
 789 print DEBUG "maintainer add >$p|$addmaint<\n";
 790         } else {
 791 print DEBUG "maintainer none >$p<\n";
 792         }
 793     }
 794 }
 795
 796 sub ensuremaintainersloaded {
 797     my $a,$b;
 798     return if $maintainersloaded++;
 799     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
 800     while (<MAINT>) {
 801         m/^(\S+)\s+(\S.*\S)\n$/ || &quit("maintainers bogus \`$_'");
 802         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
 803         $maintainerof{$1}= $2;
 804     }
 805     close(MAINT);
 806 }