scripts/service.in

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