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 style=\"white-space: pre-wrap\">\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 "<SELECT NAME=\"decision_$file\">
 249 <OPTION VALUE=\"approve\">Approve</OPTION>
 250 <OPTION VALUE=\"skip\" SELECTED>Leave</OPTION>
 251 <OPTION VALUE=\"leave\">Back of queue</OPTION>
 252 ";
 253
 254   foreach (@short_rejection_reasons) {
 255       print "<OPTION VALUE=\"reject $_\">Reject \u$_</OPTION>\n";
 256   }
 257   print "</SELECT> <BR> Comment (to poster, in rejection message): <INPUT NAME=comment VALUE=\"\" SIZE=80><BR>";
 258
 259   print "<BR>
 260 <INPUT TYPE=radio NAME=poster_decision VALUE=nothing CHECKED>Don't change poster's status</INPUT>
 261 <INPUT TYPE=radio NAME=poster_decision VALUE=preapprove
 262 >White-list poster</INPUT>
 263 <INPUT TYPE=radio NAME=poster_decision VALUE=suspicious>
 264 Add poster to watch list</INPUT>
 265
 266 <BR><BR>
 267 <I>
 268 NOTE: Decisions to watchlist and whitelist posters can be reversed by
 269 editing the respective lists of whitelisted and watchlisted posters.
 270 ";
 271
 272   &link_to_help( "filter-lists", "automatic filtering and filter lists, blacklisting and preapproved threads." );
 273
 274   print "</I>You may also wish to read the <A href=\"http://www.chiark.greenend.org.uk/~webstump/g.ulm/rrtable.html\" target=\"_blank\">summary of rejection reasons</a> (opens in a new window).\n<BR><BR>
 275
 276 <INPUT TYPE=radio NAME=next_screen VALUE=single CHECKED>
 277         Review ONE article in next screen
 278 <INPUT TYPE=radio NAME=next_screen VALUE=multiple>
 279         Review multiple articles in next screen
 280 <HR>
 281
 282 <INPUT TYPE=submit VALUE=\"Submit\">
 283 <INPUT TYPE=submit NAME=skip_submit VALUE=\"Skip\">
 284 <INPUT TYPE=reset VALUE=\"Reset\">
 285 ";
 286
 287       print "</FORM>\n\n";
 288   print "<FORM METHOD=$request_method action=$base_address>";
 289   &html_print_credentials;
 290   print "<INPUT NAME=action VALUE=moderator_admin TYPE=hidden>
 291          <INPUT TYPE=submit VALUE=\"Go to Management Page Instead of Moderating This Post\">
 292          </FORM>";
 293   print "<BR><A HREF=$base_address?action=change_password&newsgroup=$newsgroup&" .
 294         "moderator=$moderator&password=$password>Change Password</A>";
 295
 296   closedir( QUEUE );
 297   &end_html;
 298 }
 299
 300 # WebSTUMP administrative screen
 301 sub webstump_admin_screen {
 302
 303   &verify_admin_password;
 304
 305   my $password = $request{'password'};
 306
 307   &begin_html( "WebSTUMP Administration" );
 308   print "
 309 <FORM METHOD=$request_method action=$base_address>
 310 <INPUT NAME=action VALUE=admin_add_newsgroup TYPE=hidden>
 311 <INPUT NAME=password VALUE=\"$password\" TYPE=hidden>\n";
 312
 313
 314   print "
 315 <HR>
 316 Create a new newsgroup on the server:<BR>
 317
 318 Newsgroup:<BR> <INPUT NAME=newsgroup_name VALUE=\"\" SIZE=50><BR>
 319 Address to send approved/rejected messages <BR>
 320         <INPUT NAME=newsgroup_approved_address VALUE=\"\" SIZE=30><BR>
 321 Admin Password For this group:<BR> <INPUT NAME=newsgroup_password VALUE=\"\" SIZE=10><BR>
 322 <INPUT TYPE=submit VALUE=\"Submit\">
 323 <INPUT TYPE=reset VALUE=\"Reset\"><HR>
 324 ";
 325
 326       print "</FORM>\n\n<PRE>\n";
 327
 328   &end_html;
 329 }
 330
 331 # WebSTUMP "add newsgroup" function
 332 sub admin_add_newsgroup {
 333
 334   &verify_admin_password;
 335
 336   my $newsgroup = &required_parameter( 'newsgroup_name' );
 337
 338   $newsgroup =~ s/\///g;
 339   $newsgroup = &untaint( $newsgroup );
 340
 341   my $address = &required_parameter( 'newsgroup_approved_address' );
 342   my $password = &required_parameter( 'newsgroup_password' );
 343
 344   &user_error( "Newsgroup $newsgroup already exists" )
 345     if defined $newsgroups_index{$newsgroup};
 346
 347   &user_error( "Password may only contain letters and digits" )
 348     if( ! ($password =~ /^[a-zA-Z0-9]+$/ ) );
 349
 350   &begin_html( "WebSTUMP Administration: Newsgroup created" );
 351
 352   print "<PRE>\n\n";
 353
 354   print "Adding $newsgroup to $webstump_home/config/newsgroups.lst...";
 355   mkdir "$webstump_home/queues/$newsgroup", 0755;
 356   print " done.\n";
 357
 358   $dir = "$webstump_home/config/newsgroups/$newsgroup";
 359
 360   print "Creating $dir...";
 361   mkdir $dir, 0755;
 362   print " done.\n";
 363
 364   print "Creating files in $dir...";
 365
 366   &append_to_file( "$dir/address.txt", "$address\n" );
 367   &append_to_file( "$dir/moderators", "ADMIN \U$password\n" );
 368   &append_to_file( "$dir/rejection-reasons",
 369 "offtopic::a blatantly offtopic article, spam
 370 harassing::message of harassing content
 371 charter::message poorly formatted
 372 " );
 373   print " done.\n";
 374
 375
 376   print "</PRE>\n";
 377
 378   &end_html;
 379 }
 380
 381 #
 382 #
 383 sub print_images {
 384   $web_subdir = pop( @_ );
 385   $subdir = pop( @_ );
 386   $newsgroup = pop( @_ );
 387
 388   opendir( SUBDIR, $subdir );
 389
 390   my $count = 0;
 391
 392   while( $_ = readdir( SUBDIR ) ) {
 393     my $file = "$subdir/$_";
 394     next if( ! -f $file || ! -r $file );
 395     my $extension = $file;
 396     $extension =~ s/^.*\.//;
 397     $extension = "\L$extension";
 398
 399     if( $extension eq "gif" || $extension eq "jpg" || $extension eq "jpeg" ) {
 400       print "<CENTER> <IMG SRC=$base_address_for_files/queues/$newsgroup/$web_subdir/$_></CENTER><HR>\n";
 401       $count++;
 402     } else {
 403       my $filename = $_;
 404       $filename =~ s/^.*\///;
 405       next if $filename eq "skeleton.skeleton"
 406               || $filename eq "headers.txt"
 407               || $filename eq "full_message.txt"
 408               || $filename eq "text.files.lst"
 409               || $filename eq "stump-prolog.txt"
 410               || $filename eq "stump-warning.txt"
 411               || $filename =~ /msg-.*\.doc/;
 412
 413       &print_image( "no_image.gif", "security warning" );
 414       print "<B>Non-image attachment:</B><CODE>$filename</CODE> NOT SHOWN for security reasons.<BR>\n";
 415     }
 416   }
 417   return $count;
 418 }
 419
 420 # prints warning if there is warning stored about the article
 421 sub print_article_warning { # short-subdir
 422   my $file = pop( @_ );
 423
 424   my $warning_file = &article_file_name( $file ) . "/stump-warning.txt";
 425
 426   if( -r $warning_file ) {
 427     open( WARNING, $warning_file );
 428     while ($warning = <WARNING>) {
 429         next unless $warning =~ m/\S/;
 430         $warning =~ s/\&/&amp;/g;
 431         $warning =~ s/</&lt;/g;
 432         $warning =~ s/>/&gt;/g;
 433         &print_image( "star.gif", "warning" );
 434         print "<FONT COLOR=red>$warning</FONT><br>\n";
 435     }
 436     close( WARNING );
 437     return 1;
 438   }
 439
 440   return 0;
 441 }
 442
 443 sub get_queue_list ($) {
 444     my ($newsgroup) = @_;
 445     my $dir = "$queues_dir/$newsgroup";
 446     my %sortkeys;
 447
 448     opendir(QUEUED, $dir) or &error("could not open directory $dir");
 449
 450     for (;;) {
 451         $!=0;
 452         my $subdir= scalar readdir(QUEUED);
 453         last unless defined $subdir;
 454
 455         my $subpath= "$dir/$subdir";
 456         next if $subdir =~ /^\.+/;
 457         next unless -d $subpath;
 458         my $sortkey;
 459         if (!stat "$subpath/stump-warning.txt") {
 460             $!==&ENOENT or die "$subpath $!";
 461             $sortkey= 0;
 462         } else {
 463             $sortkey= (stat _)[9];
 464         }
 465         $sortkeys{$subdir}= $sortkey;
 466     }
 467     closedir( QUEUED );
 468     my @articles= sort { $sortkeys{$a} <=> $sortkeys{$b} } keys %sortkeys;
 469     return ($dir, @articles);
 470 }
 471
 472 # main moderation page -- multiple-articles version
 473 sub html_moderation_screen {
 474   my $newsgroup = &required_parameter( 'newsgroup' );
 475   my $moderator = $request{'moderator'};
 476   my $password = $request{'password'};
 477
 478
 479   if( $request{'next_screen'} eq 'single' ) {
 480     # we show a single article if the user so requested.
 481     # just get the first article from the queue if any, otherwise show
 482     # an empty main screen.
 483
 484     my ($dir, @articles)= get_queue_list($newsgroup);
 485
 486     my $i;
 487     for ($i=0; $i<@articles; $i++) {
 488         my $subdir= shift @articles;
 489         push @articles, $subdir;
 490         last if $request{"decision_$subdir"};
 491     }
 492
 493     while( $subdir = shift @articles ) {
 494       if( -d "$dir/$subdir" && !($subdir =~ /^\.+/)
 495           && open( PROLOG, "$dir/$subdir/stump-prolog.txt" ) ) {
 496               &html_moderate_article( $subdir );
 497               return;
 498       }
 499     }
 500   } else {
 501         # otherwise just show the moderator an empty main screen.
 502   }
 503
 504   &begin_html( "Main Moderation Screen: $newsgroup" );
 505   print "Welcome to the main moderation screen. Its main purpose is to
 506 help you process most messages extremely quickly. For every message, it
 507 presents you who sent it, as well as the first three non-blank lines.
 508 For those messages where the decision is obvious, simply select your
 509 decision (approve/reject etc) and click submit. For those messages which
 510 you would like to review in more details, do not select anything and
 511 use Review/Comment function from this screen or from a subsequent screen.
 512 Remember that if you do not make any decision, the article would stay in the
 513 queue. See also the <A href=\"http://www.chiark.greenend.org.uk/~webstump/g.ulm/rrtable.html\" target=\"_blank\">summary of rejection reasons</a> (opens in a new window).\n";
 514
 515   &read_rejection_reasons;
 516
 517   my ($dir, @articles)= get_queue_list($newsgroup);
 518
 519   print "
 520   <FORM METHOD=$request_method action=$base_address>
 521   <INPUT NAME=action VALUE=approval_decision TYPE=hidden>";
 522     &html_print_credentials;
 523
 524     print "<HR> <INPUT TYPE=submit VALUE=Submit>
 525 <INPUT TYPE=reset VALUE=Reset>
 526 ";
 527
 528   my $file, $subject = "No Subject", $from = "From nobody";
 529   my $form_not_empty = "";
 530   my $article_count = 0;
 531   my $warning = "";
 532   while( ($subdir = shift @articles) && $article_count++ < 40 ) {
 533     $file=$subdir;
 534     if( -d "$dir/$subdir" && !($subdir =~ /^\.+/)
 535         && open( PROLOG, "$dir/$subdir/stump-prolog.txt" ) ) {
 536         while( <PROLOG> ) {
 537           chop;
 538           if( /^Real-Subject: /i ) {
 539             s/\&/&amp;/g;
 540             s/</&lt;/g;
 541             s/>/&gt;/g;
 542             s/^Real-Subject: //g;
 543             $subject = substr( $_, 0, 50 );
 544           } elsif( /^From: /i ){
 545             s/\&/&amp;/g;
 546             s/</&lt;/g;
 547             s/>/&gt;/g;
 548             $from = substr( $_, 0, 50 );
 549           } elsif( /^$/ ) {
 550             last;
 551           }
 552         }
 553
 554         print "<HR><B>$from: $subject</B>(";
 555         print "<A HREF=$base_address?action=moderate_article&newsgroup=$newsgroup&" .
 556               "moderator=$moderator&password=$password&file=$subdir>Review/Comment/Whitelist</A>)<BR>\n";
 557         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=approve>Approve\n";
 558         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=skip>Leave\n";
 559         print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=leave>Back of queue\n";
 560         foreach (@short_rejection_reasons) {
 561           print "<INPUT TYPE=radio NAME=\"decision_$file\" VALUE=\"reject $_\">Reject \u$_\n";
 562         }
 563
 564         print "<BR>\n";
 565
 566         &print_article_warning( $file );
 567
 568         print "<PRE>\n";
 569
 570         my $i = 0;
 571
 572         while( ($_ = <PROLOG>) && $i < 8 ) {
 573             chop;
 574             next if m/^\>/;
 575             s/\&/&amp;/g;
 576             s/</&lt;/g;
 577             s/>/&gt;/g;
 578             if( $_ ne "" ) {
 579               print "]  " . substr( $_, 0, 75 ) . "\n";
 580               $i++;
 581             }
 582         }
 583
 584         print "</PRE>";
 585         $form_not_empty = "yes";
 586         close( PROLOG );
 587         $article_count += &print_images( $newsgroup, "$dir/$subdir", $subdir );
 588     }
 589   }
 590
 591   if( $form_not_empty ) {
 592     print "<HR> <INPUT TYPE=submit VALUE=Submit>
 593 <INPUT TYPE=reset VALUE=Reset>
 594 ";
 595   } else {
 596     print "
 597 <HR>
 598 No articles present in the queue
 599 <INPUT TYPE=submit VALUE=Refresh>
 600 <HR>\n";
 601   }
 602
 603   print "<A HREF=$base_address?action=change_password&newsgroup=$newsgroup&" .
 604         "moderator=$moderator&password=$password>Change Password</A>";
 605
 606   print "</FORM>\n\n";
 607
 608   print "<FORM METHOD=$request_method action=$base_address>";
 609   &html_print_credentials;
 610   print "<INPUT NAME=action VALUE=moderator_admin TYPE=hidden>
 611          <INPUT TYPE=submit VALUE=\"Management\">
 612          </FORM>";
 613
 614   &end_html;
 615 }
 616
 617 # prints hidden fields -- credentials
 618 sub html_print_credentials {
 619   my $newsgroup = $request{'newsgroup'};
 620   my $moderator = $request{'moderator'};
 621   my $password = $request{'password'};
 622
 623   print "
 624  <INPUT NAME=newsgroup VALUE=\"$newsgroup\" TYPE=hidden>
 625  <INPUT NAME=moderator VALUE=\"$moderator\" TYPE=hidden>
 626  <INPUT NAME=password VALUE=\"$password\" TYPE=hidden>\n";
 627 }
 628
 629 # logs
 630
 631 sub scanlogs ($$$) {
 632     my ($forwards, $gotr, $callback) = @_;
 633     my $dir= "$webstump_home/..";
 634     opendir LOGSDIR, "$dir" or die "$dir $!";
 635     my $num= sub {
 636         local ($_) = @_;
 637         return $forwards * (
 638             m/^errs$/ ? 1 :
 639             m/^errs\.(\d+)(?:\.gz$)$/ ? ($1+2) :
 640             0
 641                            );
 642     };
 643     foreach my $leaf (
 644                       sort { $num->($a) <=> $num->($b) }
 645                       grep { $num->($_) }
 646                       readdir LOGSDIR
 647                       ) {
 648         my $file= "$dir/$leaf";
 649         if ($file =~ m/\/errs.*\.gz$/) {
 650             open LOGFILE, "zcat $file | tac |" or die "zcat $file | tac $!";
 651         } elsif ($file =~ /errs/) {
 652             open LOGFILE, "tac $file |" or die "tac $file $!";
 653         } else {
 654             die "Unexpected filename in scanlogs: $file";
 655         }
 656         while (<LOGFILE>) {
 657             my $tgot= $callback->();
 658             next unless $tgot;
 659             $$gotr= $tgot if $tgot > $$gotr;
 660             last if $tgot > 1;
 661         }
 662         $!=0; $?=0; close LOGFILE or die "$file $? $!";
 663         last if $$gotr > 1;
 664     }
 665     closedir LOGSDIR or die "$dir $!";
 666 }
 667
 668 sub html_search_logs {
 669   &begin_html("Search logs for $request{'newsgroup'}");
 670   my $reqnum;
 671   my $forwards=1;
 672   my $min= 9;
 673   if ($request{'download_logs'}) {
 674       print "<h2>Complete log download</h2>\n";
 675       $min= 2;
 676   } elsif ($request{'messagenum'} =~ m/^\s*(\d+)\s*$/) {
 677       $reqnum= $1;
 678       $forwards= -1;
 679       $min= 1;
 680       print "<h2>Log entry for single message $reqnum</h2>\n";
 681   } else {
 682       print "<h2>Log lookup - bad reference</h2>
 683 Please supply the numerical reference as found in the \"recent activity\"
 684 log or message headers.  Reference numbers consist entirely of digits,
 685 and are often quoted in message headers in [square brackets].<p>
 686         ";
 687       &end_html;
 688       return;
 689   }
 690   if ($mod_log_access < $min) {
 691       print "Not permitted [$mod_log_access<$min].  Consult administrator.\n";
 692       &end_html;
 693       return;
 694   }
 695
 696   my $sofar= 0;
 697   &scanlogs($forwards, \$sofar, sub {
 698       return 0 unless chomp;
 699       return 0 unless m/^DECISION: /;
 700       my @vals = split / \| /, $';
 701       return 0 unless @vals >= 5;
 702       my $subj= pop @vals;
 703       my ($group,$dir,$act,$reason,$timet) = @vals;
 704       my $date= $timet ? (strftime "%Y-%m-%d %H:%M:%S GMT", gmtime $timet)
 705           : "(unknown)";
 706       return 0 unless $group eq $request{'newsgroup'};
 707       return 0 unless $subj =~ m,/(\d+)$,;
 708       my $treqnum= $1;
 709       return 0 if defined($reqnum) and $treqnum ne $reqnum;
 710       print "<table rules=all><tr><th>Date<th>Reference<th>Disposal<th>Reason</tr>\n"
 711           unless $sofar;
 712       print "<tr>", (map { "<td>".escapeHTML($_) }
 713                      $date,$treqnum,$act,$reason);
 714       print "</tr>\n";
 715       return defined($reqnum) ? 2 : 1;
 716   });
 717   if ($sofar) {
 718       print "</table>" if $sofar;
 719       print "\n";
 720   } else {
 721       print "Reference not found.".
 722           "  (Perhaps message has expired, or is still in the queue?)";
 723   }
 724   &end_html;
 725 }
 726
 727 # newsgroup admin page
 728 sub html_newsgroup_management {
 729   &begin_html( "Administer $request{'newsgroup'}" );
 730
 731   print "All usernames and passwords are not case sensitive.\n";
 732   print "<HR>Use this form to add new moderators or change passwords:<BR>
 733  <FORM METHOD=$request_method action=$base_address>
 734  <INPUT NAME=action VALUE=add_user TYPE=hidden>";
 735   &html_print_credentials;
 736   print "
 737  Username: <INPUT NAME=user VALUE=\"\" SIZE=20>
 738  <BR>
 739  Password: <INPUT NAME=new_password VALUE=\"\" SIZE=20>
 740  <BR>
 741  <INPUT TYPE=submit VALUE=\"Add/Change\">
 742  <INPUT TYPE=reset VALUE=Reset>
 743  </FORM>
 744 ";
 745
 746   print "<HR>Use this form to delete moderators:<BR>
 747  <FORM METHOD=$request_method action=$base_address>
 748  <INPUT NAME=action VALUE=delete_user TYPE=hidden>";
 749   &html_print_credentials;
 750   print "
 751  Username: <INPUT NAME=user VALUE=\"\" SIZE=20>
 752  <BR>
 753  <INPUT TYPE=submit VALUE=\"Delete Moderator\">
 754  <INPUT TYPE=reset VALUE=Reset>
 755  </FORM><HR>
 756
 757  <FORM METHOD=$request_method action=$base_address>
 758  <INPUT NAME=action VALUE=edit_list TYPE=hidden>";
 759   &html_print_credentials;
 760   print "
 761   Configuration List: <SELECT NAME=list_to_edit>
 762
 763     <OPTION VALUE=good.posters.list>Good Posters List
 764     <OPTION VALUE=watch.posters.list>Suspicious Posters List
 765     <OPTION VALUE=watch.words.list>Suspicious Words List
 766
 767   </SELECT>
 768   <INPUT TYPE=submit VALUE=\"Edit\">
 769   <INPUT TYPE=reset VALUE=Reset>";
 770
 771   &link_to_help( "filter-lists", "filtering lists" );
 772
 773   print "</FORM><HR>";
 774
 775   if ($mod_log_access) {
 776       print "<form>
 777         Use this form to search logs of past moderation decisions:
 778         <br>
 779         <form method=$request_method action=$base_address>
 780         <input name=action value=search_logs type=hidden>";
 781
 782       &html_print_credentials;
 783
 784       print "
 785         Reference number: <input name=messagenum size=30>
 786         <input type=submit value=\"Lookup\">";
 787
 788       print "
 789         <input type=submit value=\"Download all logs\" name=\"download_logs\">"
 790         if $mod_log_access >= 2;
 791
 792       print "</form><hr>\n";
 793   }
 794
 795   print "
 796
 797   List of current moderators:<P>
 798
 799   <UL>\n";
 800
 801   foreach (keys %moderators) {
 802       print "<LI> $_\n";
 803   }
 804
 805   print "</UL>\n";
 806
 807   print "<HR>See the <A href=\"http://www.chiark.greenend.org.uk/~webstump/g.ulm/rrtable.html\" target=\"_blank\">summary of rejection reasons</a> (opens in a new window).\n";
 808
 809   print "<HR><FORM METHOD=$request_method action=$base_address>";
 810   &html_print_credentials;
 811   print "<INPUT NAME=action VALUE=moderation_screen TYPE=hidden>
 812          <INPUT TYPE=submit VALUE=\"Go to moderation screen\">
 813          </FORM>";
 814
 815   &end_html;
 816 }
 817
 818
 819 # edit config list
 820 sub edit_configuration_list {
 821
 822   my $list_to_edit = &required_parameter( 'list_to_edit' );
 823
 824   $list_to_edit = &check_config_list( $list_to_edit );
 825
 826   my $list_file = &full_config_file_name( $list_to_edit );
 827
 828   my $list_content = "";
 829
 830   if( open( LIST, $list_file ) ) {
 831     $list_content .= $_ while( <LIST> );
 832     close( LIST );
 833   }
 834
 835   $list_content =~ s/\&/&amp;/g;
 836   $list_content =~ s/</&lt;/g;
 837   $list_content =~ s/>/&gt/g;
 838
 839   &begin_html( "Edit $list_to_edit" );
 840
 841   print
 842 " <FORM METHOD=$request_method action=$base_address>
 843  <INPUT NAME=action VALUE=set_config_list TYPE=hidden>
 844  <INPUT NAME=list_to_edit VALUE=$list_to_edit TYPE=hidden>";
 845   &html_print_credentials;
 846   &link_to_help( $list_to_edit, "$list_to_edit" );
 847   print "
 848  Edit this list: <HR>
 849 <TEXTAREA NAME=list rows=20 COLS=50>
 850 $list_content</TEXTAREA>
 851
 852  <BR>
 853  <INPUT TYPE=submit VALUE=\"Set\">
 854  </FORM>
 855 ";
 856
 857   &end_html;
 858 }
 859
 860 # password change page
 861 sub html_change_password{
 862   &begin_html( "Change Password" );
 863
 864   print "All usernames and passwords are not case sensitive.\n";
 865   print "<HR>Use this form to change your password:<BR>
 866  <FORM METHOD=$request_method action=$base_address>
 867  <INPUT NAME=action VALUE=validate_change_password TYPE=hidden>";
 868   &html_print_credentials;
 869   print "
 870  <BR>
 871  New Password: <INPUT NAME=new_password VALUE=\"\" SIZE=20>
 872  <BR>
 873  <INPUT TYPE=submit VALUE=Submit>
 874  <INPUT TYPE=reset VALUE=Reset>
 875  </FORM>
 876 ";
 877
 878   &end_html;
 879 }
 880
 881
 882 # newsgroup creation form
 883 sub init_request_newsgroup_creation{
 884   my $newsgroup = &required_parameter( 'newsgroup' );
 885
 886   &begin_html( "Request Creation of $newsgroup" );
 887
 888   print "This page helps you ask the system administrator of your domain
 889 to create <B>$newsgroup</B> on your server. Type in your domain name and
 890 click SUBMIT. An email will be sent to news\@domain and usenet\@domain
 891 and postmaster\@domain
 892 asking them to create your newsgroup. Please do NOT abuse this system.
 893 NOTE: You can give the URL of this page to your group readers so that
 894 they could request creation of their newsgroups by themselves.\n";
 895
 896   print "<HR>
 897  <FORM METHOD=$request_method action=$base_address>
 898  <INPUT NAME=action VALUE=complete_newsgroup_creation_request TYPE=hidden>\n";
 899   &html_print_credentials;
 900   print "
 901  <BR>
 902  Domain Name ONLY: <INPUT NAME=domain_name VALUE=\"\" SIZE=40>
 903  <BR>
 904  <INPUT TYPE=submit VALUE=Submit>
 905  <INPUT TYPE=reset VALUE=Reset>
 906  </FORM>
 907 ";
 908
 909   &end_html;
 910 }
 911
 912
 913 # newsgroup creation completion
 914 sub complete_newsgroup_creation_request{
 915   my $newsgroup = &required_parameter( 'newsgroup' );
 916   my $domain_name = &required_parameter( 'domain_name' );
 917
 918   if( !($domain_name =~ /(^[a-zA-Z0-9\.-_]+$)/) ) {
 919     &user_error( "invalid domain name" );
 920   }
 921
 922   $domain_name = $1;
 923
 924
 925   my $request = "To: news\@$domain_name, usenet\@$domain_name, postmaster\@$domain_name
 926 Subject: Please create $newsgroup (Moderated)
 927 From: devnull\@algebra.com ($newsgroup Moderator)
 928 Organization: stump.algebra.com
 929
 930 Dear News Administrator:
 931
 932 A user of $domain_name has requested that you create a newsgroup
 933
 934         $newsgroup (Moderated)
 935
 936 on your server. $newsgroup
 937 is a legitimately created moderated newsgroup that is available worldwide.
 938
 939 Thank you very much for your help and cooperation.
 940
 941 Sincerely,
 942
 943         - Moderator of $newsgroup.
 944
 945 ";
 946
 947   &email_message( $request, "news\@$domain_name" );
 948   &email_message( $request, "usenet\@$domain_name" );
 949   &email_message( $request, "postmaster\@$domain_name" );
 950
 951   &begin_html( "Request to create $newsgroup sent" );
 952
 953   print "The following request has been sent:<HR><PRE>\n";
 954
 955   print "$request</PRE>\n";
 956
 957   &end_html;
 958 }
 959
 960 # displays help
 961 sub display_help {
 962   my $topic_name = &required_parameter( "topic" );
 963
 964   $topic_name =~ s/\///g;
 965   $topic_name =~ s/\.\.//g;
 966   $topic_name = &untaint( $topic_name );
 967
 968   my $file = "$webstump_home/doc/help/$topic_name.html";
 969
 970   &error( "Topic $topic_name not found in $file." )
 971         if ! -r $file;
 972
 973   open( FILE, "$file" );
 974   my $help = "";
 975   $help .= $_ while( <FILE> );
 976   close( FILE );
 977
 978   $help =~ s/##/$base_address?action=help&topic=/g;
 979
 980   &begin_html( "$topic_name" );
 981
 982   print $help;
 983
 984   print "<HR>";
 985 }
 986
 987
 988
 989
 990
 991
 992
 993 1;