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