webstump/scripts/html_output.pl

   1 #
   2 # This is a module with functions for HTML output.
   3 #
   4 # I separate it from the main STUMP stuff because these functions are
   5 # bulky and not very interesting.
   6 #
   7 #
   8
   9 use POSIX;
  10 use CGI qw/escapeHTML/;
  11
  12 sub begin_html {
  13   my $title = pop( @_ );
  14   print
  15 "Content-Type: text/html\n\n
  16 <TITLE>$title</TITLE>
  17 <BODY>
  18 <H1>$title</H1>\n\n";
  19
  20   if( &is_demo_mode ) {
  21     print "<B> You are operating in demonstration mode. User actions will have no effect.</B><HR>\n";
  22   }
  23
  24 }
  25
  26 sub end_html {
  27   print "\n<HR>Thank you for using <A HREF=$STUMP_URL>STUMP Robomoderator</A>.
  28 <!-- <BR>
  29 Click <A HREF=$base_address>here</A> to return to WebSTUMP. -->
  30 ";
  31 }
  32
  33 # prints a link to help
  34 # accepts topic id and topic name.
  35 #
  36 sub link_to_help {
  37   my $topic_name = pop( @_ );
  38   my $topic = pop( @_ );
  39
  40   #&print_image( "help.gif", "" );
  41
  42   print "<A HREF=$base_address?action=help&topic=$topic TARGET=new>Click here for help on $topic_name</A>\n";
  43 }
  44
  45 #
  46 # prints image and an alt text
  47 #
  48 sub print_image { # image_file, alt_text
  49   my $alt = pop( @_ );
  50   my $file = pop( @_ );
  51
  52   print "<IMG SRC=$base_address_for_files/images/$file ALT=\"$alt\" ALIGN=BOTTOMP>\n";
  53 }
  54
  55 # prints the welcome page and login screen.
  56 sub html_welcome_page {
  57   &begin_html( "Welcome to WebSTUMP" );
  58
  59   print
  60
  61 "Welcome to WebSTUMP, the moderators' front end for <A
  62 HREF=http://www.algebra.com/~ichudov/stump>STUMP</A> users -- USENET newsgroup
  63 moderators. Only authorized users are allowed to log into this
  64 program.
  65
  66 <HR>";
  67
  68   my $motd_file = "$webstump_home/config/motd";
  69
  70   if( -f $motd_file && -r $motd_file ){
  71     open( MOTD, $motd_file );
  72     print "<B>Message of the Day:</B><BR><PRE>\n";
  73     print while( <MOTD> );
  74     close( MOTD );
  75     print "</PRE><HR>\n";
  76   }
  77
  78   print "
  79 Newsgroups Status:<BR>
  80 <TABLE BORDER=3>\n";
  81
  82   for( sort @newsgroups_array ) {
  83     print "<TR><TD>";
  84
  85     my $count = &get_article_count( $_ );
  86
  87     print " <A HREF=$base_address?action=login_screen\&newsgroup=$_>$_</A>";
  88     &print_image( "smiley.gif", "" ) if $count;
  89     print "</TD>";
  90
  91
  92     print "<TD>$count messages in queue<BR></TD>";
  93 #    print "<TD><A HREF=$base_address?action=init_request_newsgroup_creation\&newsgroup=$_>Request creation</A></TD>\n";
  94   }
  95
  96   print "</TABLE>\n";
  97   print "<HR>Note: click on the newsgroup to login in as moderator.
  98 <!-- Click on 'Request Creation' to ask a sysadmin at a specific domain
  99 to carry your newsgroup. -->\n<HR>
 100 <A HREF=$base_address?action=admin_login>Click here to administer this WebSTUMP installation</A>
 101 ";
 102   &end_html;
 103 }
 104
 105 # prints the login screen for newsgroup.
 106 sub html_login_screen {
 107   my $newsgroup = $request{'newsgroup'} || &error( "newsgroup not defined" );
 108
 109   my $count = &get_article_count( $newsgroup );
 110
 111
 112   if( $count ) {
 113     &begin_html( "$count articles in queue for $newsgroup" );
 114   } else {
 115     &begin_html( "Empty Queue for $newsgroup" );
 116   }
 117
 118   print
 119 " Welcome to the Moderation  Center for  $newsgroup. Please bookmark
 120 this page. <HR>";
 121
 122
 123   my $color = "", $end_color = "";
 124
 125   if( $count ) {
 126     $color = "<font color=red>";
 127     $end_color = "<font color=black>";
 128   }
 129
 130   print
 131 "<FORM METHOD=$request_method action=$base_address>
 132  <INPUT NAME=action VALUE=moderation_screen TYPE=hidden>
 133   $color ($count ";
 134
 135   &print_image( "new_tiny2.gif", "new" ) if $count;
 136
 137   print " articles available)<BR> $end_color
 138  Login: <INPUT NAME=moderator VALUE=\"\" SIZE=20>
 139  <BR>
 140  Password: <INPUT NAME=password TYPE=password VALUE=\"\" SIZE=20>
 141  <BR>
 142  <INPUT TYPE=submit VALUE=\"Proceed with Login\">
 143  <INPUT TYPE=reset VALUE=\"Reset\">
 144  <INPUT NAME=newsgroup VALUE=\"$newsgroup\" TYPE=hidden>
 145  </FORM><HR>
 146   Please log into $newsgroup. You can only log in if you know your login id
 147   and know the secret password. You should not give your password to any
 148   unauthorized user. Your login id and password are NOT case sentitive,
 149   which means that,
 150   for example, \"xyzzy\" and \"XyZZY\" are equally valid.<P>
 151 ";
 152
 153 #  print "
 154 # Log in as \"admin\" if you want to
 155 #<UL>
 156 #  <LI> edit filtering lists.";
 157 #
 158 #  &link_to_help( "filter-lists", "Filter Lists" );
 159 #
 160 #  print "
 161 #  <LI> add/delete users or change their passwords.
 162 #  <LI> First Time Users: You have to log in as admin and add a moderator user
 163 #  who will be able to moderate the newsgroup. Then log in again as that
 164 #  user. If you are a new user, you have to have your admin password assigned to
 165 #  you by the administrator.
 166 #</UL>
 167 #
 168 #";
 169   &end_html;
 170 }
 171
 172 # prints the login screen for newsgroup.
 173 sub admin_login_screen {
 174   &begin_html( "Administrative login" );
 175
 176   print
 177 "
 178 Attention: this page is only for the maintainer of the whole WebSTUMP
 179 installation. Please return to the main page if you are not the maintainer
 180 of this installation. <HR>
 181 ";
 182
 183   print
 184 "<FORM METHOD=$request_method action=$base_address>
 185  <INPUT NAME=action VALUE=webstump_admin_screen TYPE=hidden>
 186  Password: <INPUT NAME=password TYPE=password VALUE=\"\" SIZE=20>
 187  <BR>
 188  <INPUT TYPE=submit VALUE=\"Proceed with Login\">
 189  <INPUT TYPE=reset VALUE=\"Reset\">
 190  </FORM>
 191 ";
 192
 193   &end_html;
 194 }
 195
 196 # main moderation page -- single-article version
 197 sub html_moderate_article {
 198   my $newsgroup = &required_parameter( 'newsgroup' );
 199   my $moderator = $request{'moderator'};
 200   my $password = $request{'password'};
 201   my $file = shift @_ || &required_parameter('file');
 202
 203   &begin_html( "Main Moderation Screen: $newsgroup" );
 204   print "<HR>\n";
 205
 206   &read_rejection_reasons;
 207
 208   my $dir = "$queues_dir/$newsgroup";
 209
 210   if( -d "$dir/$file" && open( TEXT_FILES, "$dir/$file/text.files.lst" ) ) {
 211
 212       print "<HR>\n" if &print_article_warning( $file );
 213
 214       print "<PRE>\n";
 215       my $filename;
 216       my $inhead= 1;
 217       while( $filename = <TEXT_FILES> ) {
 218         open( ARTICLE, "$dir/$file/$filename" );
 219         while( <ARTICLE> ) {
 220           $embolden= m/^(?:from|subject)\s*\:/i;
 221           s/\&/&amp;/g;
 222           s/</&lt;/g;
 223           s/>/&gt;/g;
 224           $_= "<strong>$_</strong>" if $embolden;
 225           print;
 226           $inhead= 0 unless m/\S/;
 227         }
 228         close( ARTICLE );
 229         $inhead= 0;
 230       }
 231
 232       print "\n</PRE>\n\n";
 233
 234       &print_images( $newsgroup, "$dir/$file", $file);
 235
 236   } else {
 237     print "This message ($dir/$file) no longer exists -- maybe it was " .
 238           "approved or rejected by another moderator.";
 239   }
 240
 241       print "<HR>
 242 <FORM NAME=decision METHOD=$request_method action=$base_address>
 243 ";
 244
 245   print "
 246 <INPUT NAME=action VALUE=approval_decision TYPE=hidden>";
 247   &html_print_credentials;
 248         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=approve>Approve\n";
 249         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=skip>Leave\n";
 250         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=leave>Back of queue\n";
 251         foreach (@short_rejection_reasons) {
 252           print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=\"reject $_\">Reject \u$_\n";
 253         }
 254
 255       print "<BR> <BR> Comment (to poster, in rejection message): <INPUT NAME=comment VALUE=\"\" SIZE=80><BR>";
 256
 257   print "<BR>
 258 <INPUT TYPE=radio NAME=poster_decision VALUE=nothing CHECKED>Don't change poster's status</INPUT>
 259 <INPUT TYPE=radio NAME=poster_decision VALUE=preapprove
 260 >White-list poster</INPUT>
 261 <INPUT TYPE=radio NAME=poster_decision VALUE=suspicious>
 262 Add poster to watch list</INPUT>
 263
 264 <BR><BR>
 265 <I>
 266 NOTE: Decisions to watchlist and whitelist posters can be reversed by
 267 editing the respective lists of whitelisted and watchlisted posters.
 268 ";
 269
 270   &link_to_help( "filter-lists", "automatic filtering and filter lists, blacklisting and preapproved threads." );
 271
 272   print "</I><BR><BR>
 273
 274 <INPUT TYPE=radio NAME=next_screen VALUE=single CHECKED>
 275         Review ONE article in next screen
 276 <INPUT TYPE=radio NAME=next_screen VALUE=multiple>
 277         Review multiple articles in next screen
 278 <HR>
 279
 280 <INPUT TYPE=submit VALUE=\"Submit\">
 281 <INPUT TYPE=submit NAME=skip_submit VALUE=\"Skip\">
 282 <INPUT TYPE=reset VALUE=\"Reset\">
 283 ";
 284
 285       print "</FORM>\n\n";
 286   print "<FORM METHOD=$request_method action=$base_address>";
 287   &html_print_credentials;
 288   print "<INPUT NAME=action VALUE=moderator_admin TYPE=hidden>
 289          <INPUT TYPE=submit VALUE=\"Go to Management Page Instead of Moderating This Post\">
 290          </FORM>";
 291   print "<BR><A HREF=$base_address?action=change_password&newsgroup=$newsgroup&" .
 292         "moderator=$moderator&password=$password>Change Password</A>";
 293
 294   closedir( QUEUE );
 295   &end_html;
 296 }
 297
 298 # WebSTUMP administrative screen
 299 sub webstump_admin_screen {
 300
 301   &verify_admin_password;
 302
 303   my $password = $request{'password'};
 304
 305   &begin_html( "WebSTUMP Administration" );
 306   print "
 307 <FORM METHOD=$request_method action=$base_address>
 308 <INPUT NAME=action VALUE=admin_add_newsgroup TYPE=hidden>
 309 <INPUT NAME=password VALUE=\"$password\" TYPE=hidden>\n";
 310
 311
 312   print "
 313 <HR>
 314 Create a new newsgroup on the server:<BR>
 315
 316 Newsgroup:<BR> <INPUT NAME=newsgroup_name VALUE=\"\" SIZE=50><BR>
 317 Address to send approved/rejected messages <BR>
 318         <INPUT NAME=newsgroup_approved_address VALUE=\"\" SIZE=30><BR>
 319 Admin Password For this group:<BR> <INPUT NAME=newsgroup_password VALUE=\"\" SIZE=10><BR>
 320 <INPUT TYPE=submit VALUE=\"Submit\">
 321 <INPUT TYPE=reset VALUE=\"Reset\"><HR>
 322 ";
 323
 324       print "</FORM>\n\n<PRE>\n";
 325
 326   &end_html;
 327 }
 328
 329 # WebSTUMP "add newsgroup" function
 330 sub admin_add_newsgroup {
 331
 332   &verify_admin_password;
 333
 334   my $newsgroup = &required_parameter( 'newsgroup_name' );
 335
 336   $newsgroup =~ s/\///g;
 337   $newsgroup = &untaint( $newsgroup );
 338
 339   my $address = &required_parameter( 'newsgroup_approved_address' );
 340   my $password = &required_parameter( 'newsgroup_password' );
 341
 342   &user_error( "Newsgroup $newsgroup already exists" )
 343     if defined $newsgroups_index{$newsgroup};
 344
 345   &user_error( "Password may only contain letters and digits" )
 346     if( ! ($password =~ /^[a-zA-Z0-9]+$/ ) );
 347
 348   &begin_html( "WebSTUMP Administration: Newsgroup created" );
 349
 350   print "<PRE>\n\n";
 351
 352   print "Adding $newsgroup to $webstump_home/config/newsgroups.lst...";
 353   mkdir "$webstump_home/queues/$newsgroup", 0755;
 354   print " done.\n";
 355
 356   $dir = "$webstump_home/config/newsgroups/$newsgroup";
 357
 358   print "Creating $dir...";
 359   mkdir $dir, 0755;
 360   print " done.\n";
 361
 362   print "Creating files in $dir...";
 363
 364   &append_to_file( "$dir/address.txt", "$address\n" );
 365   &append_to_file( "$dir/moderators", "ADMIN \U$password\n" );
 366   &append_to_file( "$dir/rejection-reasons",
 367 "offtopic::a blatantly offtopic article, spam
 368 harassing::message of harassing content
 369 charter::message poorly formatted
 370 " );
 371   print " done.\n";
 372
 373
 374   print "</PRE>\n";
 375
 376   &end_html;
 377 }
 378
 379 #
 380 #
 381 sub print_images {
 382   $web_subdir = pop( @_ );
 383   $subdir = pop( @_ );
 384   $newsgroup = pop( @_ );
 385
 386   opendir( SUBDIR, $subdir );
 387
 388   my $count = 0;
 389
 390   while( $_ = readdir( SUBDIR ) ) {
 391     my $file = "$subdir/$_";
 392     next if( ! -f $file || ! -r $file );
 393     my $extension = $file;
 394     $extension =~ s/^.*\.//;
 395     $extension = "\L$extension";
 396
 397     if( $extension eq "gif" || $extension eq "jpg" || $extension eq "jpeg" ) {
 398       print "<CENTER> <IMG SRC=$base_address_for_files/queues/$newsgroup/$web_subdir/$_></CENTER><HR>\n";
 399       $count++;
 400     } else {
 401       my $filename = $_;
 402       $filename =~ s/^.*\///;
 403       next if $filename eq "skeleton.skeleton"
 404               || $filename eq "headers.txt"
 405               || $filename eq "full_message.txt"
 406               || $filename eq "text.files.lst"
 407               || $filename eq "stump-prolog.txt"
 408               || $filename eq "stump-warning.txt"
 409               || $filename =~ /msg-.*\.doc/;
 410
 411       &print_image( "no_image.gif", "security warning" );
 412       print "<B>Non-image attachment:</B><CODE>$filename</CODE> NOT SHOWN for security reasons.<BR>\n";
 413     }
 414   }
 415   return $count;
 416 }
 417
 418 # prints warning if there is warning stored about the article
 419 sub print_article_warning { # short-subdir
 420   my $file = pop( @_ );
 421
 422   my $warning_file = &article_file_name( $file ) . "/stump-warning.txt";
 423
 424   if( -r $warning_file ) {
 425     open( WARNING, $warning_file );
 426     while ($warning = <WARNING>) {
 427         next unless $warning =~ m/\S/;
 428         $warning =~ s/\&/&amp;/g;
 429         $warning =~ s/</&lt;/g;
 430         $warning =~ s/>/&gt;/g;
 431         &print_image( "star.gif", "warning" );
 432         print "<FONT COLOR=red>$warning</FONT><br>\n";
 433     }
 434     close( WARNING );
 435     return 1;
 436   }
 437
 438   return 0;
 439 }
 440
 441 sub get_queue_list ($) {
 442     my ($newsgroup) = @_;
 443     my $dir = "$queues_dir/$newsgroup";
 444     my %sortkeys;
 445
 446     opendir(QUEUED, $dir) or &error("could not open directory $dir");
 447
 448     for (;;) {
 449         $!=0;
 450         my $subdir= scalar readdir(QUEUED);
 451         last unless defined $subdir;
 452
 453         my $subpath= "$dir/$subdir";
 454         next if $subdir =~ /^\.+/;
 455         next unless -d $subpath;
 456         my $sortkey;
 457         if (!stat "$subpath/stump-warning.txt") {
 458             $!==&ENOENT or die "$subpath $!";
 459             $sortkey= 0;
 460         } else {
 461             $sortkey= (stat _)[9];
 462         }
 463         $sortkeys{$subdir}= $sortkey;
 464     }
 465     closedir( QUEUED );
 466     my @articles= sort { $sortkeys{$a} <=> $sortkeys{$b} } keys %sortkeys;
 467     return ($dir, @articles);
 468 }
 469
 470 # main moderation page -- multiple-articles version
 471 sub html_moderation_screen {
 472   my $newsgroup = &required_parameter( 'newsgroup' );
 473   my $moderator = $request{'moderator'};
 474   my $password = $request{'password'};
 475
 476
 477   if( $request{'next_screen'} eq 'single' ) {
 478     # we show a single article if the user so requested.
 479     # just get the first article from the queue if any, otherwise show
 480     # an empty main screen.
 481
 482     my ($dir, @articles)= get_queue_list($newsgroup);
 483
 484     my $i;
 485     for ($i=0; $i<@articles; $i++) {
 486         my $subdir= shift @articles;
 487         push @articles, $subdir;
 488         last if $request{"decision_$subdir"};
 489     }
 490
 491     while( $subdir = shift @articles ) {
 492       if( -d "$dir/$subdir" && !($subdir =~ /^\.+/)
 493           && open( PROLOG, "$dir/$subdir/stump-prolog.txt" ) ) {
 494               &html_moderate_article( $subdir );
 495               return;
 496       }
 497     }
 498   } else {
 499         # otherwise just show the moderator an empty main screen.
 500   }
 501
 502   &begin_html( "Main Moderation Screen: $newsgroup" );
 503   print "Welcome to the main moderation screen. Its main purpose is to
 504 help you process most messages extremely quickly. For every message, it
 505 presents you who sent it, as well as the first three non-blank lines.
 506 For those messages where the decision is obvious, simply select your
 507 decision (approve/reject etc) and click submit. For those messages which
 508 you would like to review in more details, do not select anything and
 509 use Review/Comment function from this screen or from a subsequent screen.
 510 Remember that if you do not make any decision, the article would stay in the
 511 queue.\n";
 512
 513   &read_rejection_reasons;
 514
 515   my ($dir, @articles)= get_queue_list($newsgroup);
 516
 517   print "
 518   <FORM METHOD=$request_method action=$base_address>
 519   <INPUT NAME=action VALUE=approval_decision TYPE=hidden>";
 520     &html_print_credentials;
 521
 522     print "<HR> <INPUT TYPE=submit VALUE=Submit>
 523 <INPUT TYPE=reset VALUE=Reset>
 524 ";
 525
 526   my $file, $subject = "No Subject", $from = "From nobody";
 527   my $form_not_empty = "";
 528   my $article_count = 0;
 529   my $warning = "";
 530   while( ($subdir = shift @articles) && $article_count++ < 40 ) {
 531     $file=$subdir;
 532     if( -d "$dir/$subdir" && !($subdir =~ /^\.+/)
 533         && open( PROLOG, "$dir/$subdir/stump-prolog.txt" ) ) {
 534         while( <PROLOG> ) {
 535           chop;
 536           if( /^Real-Subject: /i ) {
 537             s/\&/&amp;/g;
 538             s/</&lt;/g;
 539             s/>/&gt;/g;
 540             s/^Real-Subject: //g;
 541             $subject = substr( $_, 0, 50 );
 542           } elsif( /^From: /i ){
 543             s/\&/&amp;/g;
 544             s/</&lt;/g;
 545             s/>/&gt;/g;
 546             $from = substr( $_, 0, 50 );
 547           } elsif( /^$/ ) {
 548             last;
 549           }
 550         }
 551
 552         print "<HR><B>$from: $subject</B>(";
 553         print "<A HREF=$base_address?action=moderate_article&newsgroup=$newsgroup&" .
 554               "moderator=$moderator&password=$password&file=$subdir>Review/Comment/Whitelist</A>)<BR>\n";
 555         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=approve>Approve\n";
 556         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=skip>Leave\n";
 557         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=leave>Back of queue\n";
 558         foreach (@short_rejection_reasons) {
 559           print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=\"reject $_\">Reject \u$_\n";
 560         }
 561
 562         print "<BR>\n";
 563
 564         &print_article_warning( $file );
 565
 566         print "<PRE>\n";
 567
 568         my $i = 0;
 569
 570         while( ($_ = <PROLOG>) && $i < 5 ) {
 571             chop;
 572             next if m/^\>/;
 573             s/\&/&amp;/g;
 574             s/</&lt;/g;
 575             s/>/&gt;/g;
 576             if( $_ ne "" ) {
 577               print "]  " . substr( $_, 0, 75 ) . "\n";
 578               $i++;
 579             }
 580         }
 581
 582         print "</PRE>";
 583         $form_not_empty = "yes";
 584         close( PROLOG );
 585         $article_count += &print_images( $newsgroup, "$dir/$subdir", $subdir );
 586     }
 587   }
 588
 589   if( $form_not_empty ) {
 590     print "<HR> <INPUT TYPE=submit VALUE=Submit>
 591 <INPUT TYPE=reset VALUE=Reset>
 592 ";
 593   } else {
 594     print "
 595 <HR>
 596 No articles present in the queue
 597 <INPUT TYPE=submit VALUE=Refresh>
 598 <HR>\n";
 599   }
 600
 601   print "<A HREF=$base_address?action=change_password&newsgroup=$newsgroup&" .
 602         "moderator=$moderator&password=$password>Change Password</A>";
 603
 604   print "</FORM>\n\n";
 605
 606   print "<FORM METHOD=$request_method action=$base_address>";
 607   &html_print_credentials;
 608   print "<INPUT NAME=action VALUE=moderator_admin TYPE=hidden>
 609          <INPUT TYPE=submit VALUE=\"Management\">
 610          </FORM>";
 611
 612   &end_html;
 613 }
 614
 615 # prints hidden fields -- credentials
 616 sub html_print_credentials {
 617   my $newsgroup = $request{'newsgroup'};
 618   my $moderator = $request{'moderator'};
 619   my $password = $request{'password'};
 620
 621   print "
 622  <INPUT NAME=newsgroup VALUE=\"$newsgroup\" TYPE=hidden>
 623  <INPUT NAME=moderator VALUE=\"$moderator\" TYPE=hidden>
 624  <INPUT NAME=password VALUE=\"$password\" TYPE=hidden>\n";
 625 }
 626
 627 # logs
 628
 629 sub scanlogs ($$$) {
 630     my ($forwards, $gotr, $callback) = @_;
 631     my $dir= "$webstump_home/..";
 632     opendir LOGSDIR, "$dir" or die "$dir $!";
 633     my $num= sub {
 634         local ($_) = @_;
 635         return $forwards * (
 636             m/^errs$/ ? -1 :
 637             m/^errs\.(\d+)(?:\.gz$)$/ ? $1 :
 638             undef
 639                            );
 640     };
 641     foreach my $leaf (
 642                       sort { $num->($a) <=> $num->($b) }
 643                       grep { defined $num->($_) }
 644                       readdir LOGSDIR
 645                       ) {
 646         my $file= "$dir/$leaf";
 647         if ($file =~ m/\.gz$/) {
 648             open LOGFILE, "zcat $file |" or die "zcat $file $!";
 649         } else {
 650             open LOGFILE, "< $file" or die "$file $!";
 651         }
 652         while (<LOGFILE>) {
 653             my $tgot= $callback->();
 654             next unless $tgot;
 655             $$gotr= $tgot if $tgot > $$gotr;
 656             last if $tgot > 1;
 657         }
 658         $!=0; $?=0; close LOGFILE or die "$file $? $!";
 659         last if $$gotr > 1;
 660     }
 661     closedir LOGSDIR or die "$dir $!";
 662 }
 663
 664 sub html_search_logs {
 665   &begin_html("Search logs for $request{'newsgroup'}");
 666   my $reqnum;
 667   my $forwards=1;
 668   my $min= 9;
 669   if ($request{'download_logs'}) {
 670       print "<h2>Complete log download</h2>\n";
 671       $min= 2;
 672   } elsif ($request{'messagenum'} =~ m/^\s*(\d+)\s*$/) {
 673       $reqnum= $1;
 674       $forwards= -1;
 675       $min= 1;
 676       print "<h2>Log entry for single message $reqnum</h2>\n";
 677   } else {
 678       print "<h2>Log lookup - bad reference</h2>
 679 Please supply the numerical reference as found in the \"recent activity\"
 680 log or message headers.  Reference numbers consist entirely of digits,
 681 and are often quoted in message headers in [square brackets].<p>
 682         ";
 683       &end_html;
 684       return;
 685   }
 686   if ($mod_log_access < $min) {
 687       print "Not permitted [$mod_log_access<$min].  Consult administrator.\n";
 688       &end_html;
 689       return;
 690   }
 691
 692   my $sofar= 0;
 693   &scanlogs($forwards, \$sofar, sub {
 694       return 0 unless chomp;
 695       return 0 unless m/^DECISION: /;
 696       my @vals = split / \| /, $';
 697       return 0 unless @vals >= 5;
 698       my $subj= pop @vals;
 699       my ($group,$dir,$act,$reason,$timet) = @vals;
 700       my $date= $timet ? (strftime "%Y-%m-%d %H:%M:%S GMT", gmtime $timet)
 701           : "(unknown)";
 702       return 0 unless $group eq $request{'newsgroup'};
 703       return 0 unless $subj =~ m,/(\d+)$,;
 704       my $treqnum= $1;
 705       return 0 if defined($reqnum) and $treqnum ne $reqnum;
 706       print "<table rules=all><tr><th>Date<th>Reference<th>Disposal<th>Reason</tr>\n"
 707           unless $sofar;
 708       print "<tr>", (map { "<td>".escapeHTML($_) }
 709                      $date,$treqnum,$act,$reason);
 710       print "</tr>\n";
 711       return defined($reqnum) ? 2 : 1;
 712   });
 713   if ($sofar) {
 714       print "</table>" if $sofar;
 715       print "\n";
 716   } else {
 717       print "Reference not found.".
 718           "  (Perhaps message has expired, or is still in the queue?)";
 719   }
 720   &end_html;
 721 }
 722
 723 # newsgroup admin page
 724 sub html_newsgroup_management {
 725   &begin_html( "Administer $request{'newsgroup'}" );
 726
 727   print "All usernames and passwords are not case sensitive.\n";
 728   print "<HR>Use this form to add new moderators or change passwords:<BR>
 729  <FORM METHOD=$request_method action=$base_address>
 730  <INPUT NAME=action VALUE=add_user TYPE=hidden>";
 731   &html_print_credentials;
 732   print "
 733  Username: <INPUT NAME=user VALUE=\"\" SIZE=20>
 734  <BR>
 735  Password: <INPUT NAME=new_password VALUE=\"\" SIZE=20>
 736  <BR>
 737  <INPUT TYPE=submit VALUE=\"Add/Change\">
 738  <INPUT TYPE=reset VALUE=Reset>
 739  </FORM>
 740 ";
 741
 742   print "<HR>Use this form to delete moderators:<BR>
 743  <FORM METHOD=$request_method action=$base_address>
 744  <INPUT NAME=action VALUE=delete_user TYPE=hidden>";
 745   &html_print_credentials;
 746   print "
 747  Username: <INPUT NAME=user VALUE=\"\" SIZE=20>
 748  <BR>
 749  <INPUT TYPE=submit VALUE=\"Delete Moderator\">
 750  <INPUT TYPE=reset VALUE=Reset>
 751  </FORM><HR>
 752
 753  <FORM METHOD=$request_method action=$base_address>
 754  <INPUT NAME=action VALUE=edit_list TYPE=hidden>";
 755   &html_print_credentials;
 756   print "
 757   Configuration List: <SELECT NAME=list_to_edit>
 758
 759     <OPTION VALUE=good.posters.list>Good Posters List
 760     <OPTION VALUE=watch.posters.list>Suspicious Posters List
 761     <OPTION VALUE=watch.words.list>Suspicious Words List
 762
 763   </SELECT>
 764   <INPUT TYPE=submit VALUE=\"Edit\">
 765   <INPUT TYPE=reset VALUE=Reset>";
 766
 767   &link_to_help( "filter-lists", "filtering lists" );
 768
 769   print "</FORM><HR>";
 770
 771   if ($mod_log_access) {
 772       print "<form>
 773         Use this form to search logs of past moderation decisions:
 774         <br>
 775         <form method=$request_method action=$base_address>
 776         <input name=action value=search_logs type=hidden>";
 777
 778       &html_print_credentials;
 779
 780       print "
 781         Reference number: <input name=messagenum size=30>
 782         <input type=submit value=\"Lookup\">";
 783
 784       print "
 785         <input type=submit value=\"Download all logs\" name=\"download_logs\">"
 786         if $mod_log_access >= 2;
 787
 788       print "</form><hr>\n";
 789   }
 790
 791   print "
 792
 793   List of current moderators:<P>
 794
 795   <UL>\n";
 796
 797   foreach (keys %moderators) {
 798       print "<LI> $_\n";
 799   }
 800
 801   print "</UL>\n";
 802
 803   print "<HR><FORM METHOD=$request_method action=$base_address>";
 804   &html_print_credentials;
 805   print "<INPUT NAME=action VALUE=moderation_screen TYPE=hidden>
 806          <INPUT TYPE=submit VALUE=\"Go to moderation screen\">
 807          </FORM>";
 808
 809   &end_html;
 810 }
 811
 812
 813 # edit config list
 814 sub edit_configuration_list {
 815
 816   my $list_to_edit = &required_parameter( 'list_to_edit' );
 817
 818   $list_to_edit = &check_config_list( $list_to_edit );
 819
 820   my $list_file = &full_config_file_name( $list_to_edit );
 821
 822   my $list_content = "";
 823
 824   if( open( LIST, $list_file ) ) {
 825     $list_content .= $_ while( <LIST> );
 826     close( LIST );
 827   }
 828
 829   $list_content =~ s/\&/&amp;/g;
 830   $list_content =~ s/</&lt;/g;
 831   $list_content =~ s/>/&gt/g;
 832
 833   &begin_html( "Edit $list_to_edit" );
 834
 835   print
 836 " <FORM METHOD=$request_method action=$base_address>
 837  <INPUT NAME=action VALUE=set_config_list TYPE=hidden>
 838  <INPUT NAME=list_to_edit VALUE=$list_to_edit TYPE=hidden>";
 839   &html_print_credentials;
 840   &link_to_help( $list_to_edit, "$list_to_edit" );
 841   print "
 842  Edit this list: <HR>
 843 <TEXTAREA NAME=list rows=20 COLS=50>
 844 $list_content</TEXTAREA>
 845
 846  <BR>
 847  <INPUT TYPE=submit VALUE=\"Set\">
 848  </FORM>
 849 ";
 850
 851   &end_html;
 852 }
 853
 854 # password change page
 855 sub html_change_password{
 856   &begin_html( "Change Password" );
 857
 858   print "All usernames and passwords are not case sensitive.\n";
 859   print "<HR>Use this form to change your password:<BR>
 860  <FORM METHOD=$request_method action=$base_address>
 861  <INPUT NAME=action VALUE=validate_change_password TYPE=hidden>";
 862   &html_print_credentials;
 863   print "
 864  <BR>
 865  New Password: <INPUT NAME=new_password VALUE=\"\" SIZE=20>
 866  <BR>
 867  <INPUT TYPE=submit VALUE=Submit>
 868  <INPUT TYPE=reset VALUE=Reset>
 869  </FORM>
 870 ";
 871
 872   &end_html;
 873 }
 874
 875
 876 # newsgroup creation form
 877 sub init_request_newsgroup_creation{
 878   my $newsgroup = &required_parameter( 'newsgroup' );
 879
 880   &begin_html( "Request Creation of $newsgroup" );
 881
 882   print "This page helps you ask the system administrator of your domain
 883 to create <B>$newsgroup</B> on your server. Type in your domain name and
 884 click SUBMIT. An email will be sent to news\@domain and usenet\@domain
 885 and postmaster\@domain
 886 asking them to create your newsgroup. Please do NOT abuse this system.
 887 NOTE: You can give the URL of this page to your group readers so that
 888 they could request creation of their newsgroups by themselves.\n";
 889
 890   print "<HR>
 891  <FORM METHOD=$request_method action=$base_address>
 892  <INPUT NAME=action VALUE=complete_newsgroup_creation_request TYPE=hidden>\n";
 893   &html_print_credentials;
 894   print "
 895  <BR>
 896  Domain Name ONLY: <INPUT NAME=domain_name VALUE=\"\" SIZE=40>
 897  <BR>
 898  <INPUT TYPE=submit VALUE=Submit>
 899  <INPUT TYPE=reset VALUE=Reset>
 900  </FORM>
 901 ";
 902
 903   &end_html;
 904 }
 905
 906
 907 # newsgroup creation completion
 908 sub complete_newsgroup_creation_request{
 909   my $newsgroup = &required_parameter( 'newsgroup' );
 910   my $domain_name = &required_parameter( 'domain_name' );
 911
 912   if( !($domain_name =~ /(^[a-zA-Z0-9\.-_]+$)/) ) {
 913     &user_error( "invalid domain name" );
 914   }
 915
 916   $domain_name = $1;
 917
 918
 919   my $request = "To: news\@$domain_name, usenet\@$domain_name, postmaster\@$domain_name
 920 Subject: Please create $newsgroup (Moderated)
 921 From: devnull\@algebra.com ($newsgroup Moderator)
 922 Organization: stump.algebra.com
 923
 924 Dear News Administrator:
 925
 926 A user of $domain_name has requested that you create a newsgroup
 927
 928         $newsgroup (Moderated)
 929
 930 on your server. $newsgroup
 931 is a legitimately created moderated newsgroup that is available worldwide.
 932
 933 Thank you very much for your help and cooperation.
 934
 935 Sincerely,
 936
 937         - Moderator of $newsgroup.
 938
 939 ";
 940
 941   &email_message( $request, "news\@$domain_name" );
 942   &email_message( $request, "usenet\@$domain_name" );
 943   &email_message( $request, "postmaster\@$domain_name" );
 944
 945   &begin_html( "Request to create $newsgroup sent" );
 946
 947   print "The following request has been sent:<HR><PRE>\n";
 948
 949   print "$request</PRE>\n";
 950
 951   &end_html;
 952 }
 953
 954 # displays help
 955 sub display_help {
 956   my $topic_name = &required_parameter( "topic" );
 957
 958   $topic_name =~ s/\///g;
 959   $topic_name =~ s/\.\.//g;
 960   $topic_name = &untaint( $topic_name );
 961
 962   my $file = "$webstump_home/doc/help/$topic_name.html";
 963
 964   &error( "Topic $topic_name not found in $file." )
 965         if ! -r $file;
 966
 967   open( FILE, "$file" );
 968   my $help = "";
 969   $help .= $_ while( <FILE> );
 970   close( FILE );
 971
 972   $help =~ s/##/$base_address?action=help&topic=/g;
 973
 974   &begin_html( "$topic_name" );
 975
 976   print $help;
 977
 978   print "<HR>";
 979 }
 980
 981
 982
 983
 984
 985
 986
 987 1;