scripts/service.in

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