debbugs-service

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