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