scripts/service.in

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