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