1 # this is a collection of library functions for stump.
9 if( defined $html_mode ) {
11 "Content-Type: text/html\n\n
12 <TITLE>WebSTUMP Error</TITLE>
13 <BODY BGCOLOR=\"#C5C5FF\" BACKGROUND=$base_address_for_files/images/bg1.jpg>
14 <H1>You have encountered an error in WebSTUMP.</H1>";
16 &print_image( "construction.gif", "bug in WebSTUMP" );
18 print " <B>$msg </B><HR>
19 Please cut and paste this
20 whole page and send it to <A HREF=mailto:$supporter>$supporter</A>.<P>
21 Query Parameters:<P>\n
24 foreach (keys %request) {
25 print "<LI> $_: $request{$_}\n";
36 if( defined $html_mode ) {
38 "Content-Type: text/html\n\n
39 <TITLE>You have made a mistake.</TITLE>
40 <BODY BGCOLOR=\"#C5C5FF\" BACKGROUND=$base_address_for_files/images/bg1.jpg>
41 <H1>You have made a mistake.</H1>
44 &print_image( "warning_big.gif", "Warning" );
46 print " <B>$msg </B><HR>
47 Please go back to the previous page and correct it. If you get really
48 stuck, cut and paste this whole page and send it to <A
49 HREF=mailto:$supporter>$supporter</A>.
59 # returns full config file name
60 sub full_config_file_name {
61 my $short_name = pop( @_ );
62 my $newsgroup = &required_parameter( "newsgroup" );
63 $newsgroup =~ m/^\w[.0-9a-z+]+$/ or die;
65 return "$webstump_home/config/newsgroups/$newsgroup/$short_name";
68 # checks if the admin password supplied is correct
69 sub verify_admin_password {
71 my $password = $request{'password'};
73 my $password_file = "$webstump_home/config/admin_password.txt";
75 open( PASSWORD, $password_file )
76 || &error( "Password file $password_file does not exist" );
77 my $correct_password = <PASSWORD>;
78 chomp $correct_password;
81 &user_error( "invalid admin password" )
82 if( $password ne $correct_password );
87 # appends a string to file.
93 open_file_for_appending( FILE, "$file" )
94 || die "Could not open $file for writing";
101 sub add_to_config_file {
102 my $line = pop( @_ );
103 my $file = pop( @_ );
105 print STDERR "File = $file, line= $line\n";
107 if( !&name_is_in_list( $line, $file ) ) {
108 &report_list_diff($file, sub {
109 print DIFF "Added: $line\n" or die $!;
111 &append_to_file( &full_config_file_name( $file ), "$line\n" );
116 sub report_list_diff ($$) {
117 my ($list_file, $innards) = @_;
119 my $head = &full_config_file_name( "change-notify-header" );
120 if (!open DHEAD, '<', $head) {
121 $!==&ENOENT or die "$head $!";
124 my $diff = "$list_file.diff.$$.tmp";
126 open DIFF, '>>', $diff or die "$diff $!";
127 while (<DHEAD>) { print DIFF or die $!; }
128 print DIFF <<END or die $!;
130 Moderator: $request{'moderator'}
131 Control file: $list_file
134 DHEAD->error and die $!;
135 DIFF->flush or die $!;
137 my $goahead= &$innards($diff);
140 print DIFF "\n-- \n" or die $!;
141 close DIFF or die $!;
142 my $child= fork; die unless defined $child;
144 open STDIN, '<', $diff or die "$diff $!";
145 exec find_sendmail(), qw(-odb -oem -oee -oi -t);
148 waitpid($child,0) == $child or die "$list_file $!";
150 $?==0 or die "$list_file $?";
151 unlink $diff or die $!;
156 &error("Could not report change to $list_file: $@");
161 # unescape URL-encoded data
163 my $todecode = shift;
164 $todecode =~ tr/+/ /; # pluses become spaces
165 $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
169 # sets various useful variables, etc
170 sub setup_variables {
171 $newsgroups_list_file = "$webstump_home/config/newsgroups.lst";
174 # initializes webstump, reads newsgroups list
179 opendir( NEWSGROUPS, "$webstump_home/config/newsgroups" )
180 || &error( "can't open $webstump_home/config/newsgroups" );
182 while( $_ = readdir( NEWSGROUPS ) ) {
183 my $file = "$webstump_home/config/newsgroups/$_/address.txt";
188 open( FILE, $file ) or die $!;
190 defined $addr or die $!;
194 &error( "Invalid entry $_ in the newsgroups database." )
195 if( !$ng || !$addr );
196 push @newsgroups_array,$ng;
197 $newsgroups_index{$ng} = "$addr";
201 open( LOG, ">>$webstump_home/log/webstump.log" ) or die $!;
203 print LOG "Call from $ENV{'REMOTE_ADDR'}, QUERY_STRING=$ENV{'QUERY_STRING'}\n" or die $!;
206 # gets the directory name for the newsgroup
208 my $newsgroup = pop( @_ );
209 if( $newsgroups_index{$newsgroup} ) {
210 return "$queues_dir/$newsgroup";
212 return ""; # undefined ng
215 # reads request, if any
219 if( defined $ENV{"QUERY_STRING"} ) {
221 @query = split( /&/, $ENV{"QUERY_STRING"} );
223 my ($name, $value) = split( /=/ );
224 $result{&unescape($name)} = &unescape( $value );
229 @query = split( /&/, $_ );
231 my ($name, $value) = split( /=/ );
232 $result{&unescape($name)} = &unescape( $value );
236 foreach( keys %result ) {
237 print LOG "Request: $_ = $result{$_}\n" if( $_ ne "password" );
242 # Checks if the program is running in a demo mode
244 return &optional_parameter( 'newsgroup' ) eq "demo.newsgroup"
245 && !$ignore_demo_mode;
248 # opens file for writing
249 sub open_file_for_writing { # filehandle, filename
250 my $filename = pop( @_ );
251 my $filehandle = pop( @_ );
253 if( &is_demo_mode ) {
254 return( open( $filehandle, ">/dev/null" ) );
256 return( open( $filehandle, ">$filename" ) );
260 # opens pipe for writing
261 sub open_pipe_for_writing { # filehandle, filename
262 my $filename = pop( @_ );
263 my $filehandle = pop( @_ );
265 if( &is_demo_mode ) {
266 return( open( $filehandle, ">/dev/null" ) );
268 return( open( $filehandle, "|$filename" ) );
272 # opens file for appending
273 sub open_file_for_appending { # filehandle, filename
274 my $filename = pop( @_ );
275 my $filehandle = pop( @_ );
277 if( &is_demo_mode ) {
278 return( open( $filehandle, ">>/dev/null" ) );
280 return( open( $filehandle, ">>$filename" ) );
287 return "" if( ! defined $request{$arg} );
288 return $request{$arg};
291 # barfs if the required parameter is not supplied
292 sub required_parameter {
294 user_error( "Parameter \"$arg\" is not defined or is empty" )
295 if( ! defined $request{$arg} || !$request{$arg} );
296 return $request{$arg};
299 # optional request parameter
300 sub optional_parameter {
302 return $request{$arg};
305 # issues a security alert
308 print LOG "SECURITY_ALERT: $msg\n";
311 # reads the moderators info
312 sub read_moderators {
313 my $newsgroup = &required_parameter( "newsgroup" );
315 my $file = &full_config_file_name( "moderators" );
317 open( MODERATORS, "$file" )
318 || error( "Could not open file with moderator passwords: $file" );
320 while( <MODERATORS> ) {
321 my ($name, $pwd) = split;
322 $moderators{"\U$name"} = "\U$pwd";
328 # saves the moderators info
329 sub save_moderators {
330 my $newsgroup = &required_parameter( "newsgroup" );
332 my $file = &full_config_file_name( "moderators" );
334 open_file_for_writing( MODERATORS, $file );
335 # || &error( "Could not open file with moderator passwords: $file" );
337 foreach (keys %moderators) {
338 print MODERATORS "$_ $moderators{$_}\n";
346 my $password = &required_parameter( "password" );
347 my $moderator = &required_parameter( "moderator" );
348 my $newsgroup = &required_parameter( "newsgroup" );
352 if( !defined $moderators{"\U$moderator"} ||
353 $moderators{"\U$moderator"} ne "\U$password" ) {
354 &security_alert( "Authentication denied." )
355 &user_error( "Authentication denied." );
359 # cleans request of dangerous characters
360 sub disinfect_request {
361 if( defined $request{'newsgroup'} ) {
362 $newsgroup = $request{'newsgroup'};
363 $newsgroup =~ m/^(\w[.0-9a-z+]+)$/ or die;
365 $request{'newsgroup'} = $newsgroup;
368 if( defined $request{'file'} ) {
369 my $file = $request{'file'};
370 $file =~ m/^\w[.0-9a-z]+\.list$|^dir_\d+_\d+$/ or die "$file ?";
372 $request{'file'} = $file;
378 my $user = &required_parameter( "user" );
379 my $new_password = &required_parameter( "new_password" );
381 &user_error( "Username may only contain letters and digits" )
382 if( ! ($user =~ /^[a-zA-Z0-9]+$/ ) );
383 &user_error( "Password may only contain letters and digits" )
384 if( ! ($new_password =~ /^[a-zA-Z0-9]+$/ ) );
385 &user_error( "Cannot change password for user admin" )
386 if( "\U$user" eq "ADMIN" );
388 $moderators{"\U$user"} = "\U$new_password";
393 # checks that a config list is in enumerated set of values. Returns
395 sub check_config_list {
396 my $list_to_edit = pop( @_ );
398 &user_error( "invalid list name $list_to_edit" )
399 if( $list_to_edit ne "good.posters.list"
400 && $list_to_edit ne "watch.posters.list"
401 && $list_to_edit ne "bad.posters.list"
402 && $list_to_edit ne "watch.words.list" );
404 return &untaint( $list_to_edit );
407 # sets a configuration list (good posters etc)
408 sub set_config_list {
409 my $list_content = $request{"list"};
410 my $list_to_edit = &required_parameter( "list_to_edit" );
412 $list_content .= "\n";
413 $list_content =~ s/\r//g;
414 $list_content =~ s/\n+/\n/g;
415 $list_content =~ s/\n +/\n/g;
416 $list_content =~ s/^\n+//g;
418 $list_to_edit = &check_config_list( $list_to_edit );
420 my $list_file = &full_config_file_name( $list_to_edit );
422 open_file_for_writing( LIST, "$list_file.new" )
423 || &error( "Could not open $list_file for writing" );
424 print LIST $list_content;
427 report_list_diff("$list_to_edit", sub {
429 my $child= fork; die unless defined $child;
431 open STDOUT, '>&DIFF' or die $!;
432 exec 'diff','-u','-L', "$list_to_edit.old",'-L', "$list_to_edit.new",'--', "$list_file","$list_file.new";
435 waitpid($child,0) == $child or die "$list_file $!";
436 $?==0 or $?==256 or die "$list_file $?";
439 rename ("$list_file.new", "$list_file");
444 my $user = &required_parameter( "user" );
446 &user_error( "User \U$user" . " does not exist!" )
447 if( ! defined $moderators{"\U$user"} );
448 &user_error( "Cannot delete user admin" )
449 if( "\U$user" eq "ADMIN" );
451 delete $moderators{"\U$user"};
456 # validate password change
457 sub validate_change_password {
458 my $user = &required_parameter( "moderator" );
459 my $new_password = &required_parameter( "new_password" );
461 &user_error( "Password may only contain letters and digits" )
462 if( ! ($new_password =~ /^[a-zA-Z0-9]+$/ ) );
463 &user_error( "Cannot change password for user admin" )
464 if( "\U$user" eq "ADMIN" );
466 $moderators{"\U$user"} = "\U$new_password";
472 # reads rejection reasons
473 sub read_rejection_reasons {
474 my $newsgroup = &required_parameter( 'newsgroup' );
475 my $reasons = &full_config_file_name( "rejection-reasons" );
476 open( REASONS, $reasons ) || &error( "Could not open file $reasons" );
480 my ($name, $title) = split( /::/ );
481 $rejection_reasons{$name} = $title;
482 push @short_rejection_reasons, $name;
492 foreach (@sendmail) {
499 &error( "Sendmail not found" ) if( !$sendmail );
504 # email_message message recipient
506 my $recipient = pop( @_ );
507 my $message = pop( @_ );
508 my $sendmail= find_sendmail;
509 my $sendmail_command = "$sendmail $recipient";
510 $sendmail_command =~ /(^.*$)/;
511 $sendmail_command = $1; # untaint
512 open_pipe_for_writing( SENDMAIL, "$sendmail_command > /dev/null " )
514 print SENDMAIL $message or die $!;
515 close( SENDMAIL ) or die "$? $!";
519 sub article_file_name {
520 my $file = pop( @_ );
521 return "$queues_dir/$newsgroup/$file";
533 return if &is_demo_mode;
535 opendir( DIR, $dir ) || return;
536 while( $_ = readdir(DIR) ) {
537 unlink &untaint( "$dir/$_" );
543 sub approval_decision {
544 $newsgroup = &required_parameter( 'newsgroup' );
545 my $comment = &get_parameter( 'comment' );
548 my $poster_decision = &optional_parameter( "poster_decision" );
549 my $thread_decision = &optional_parameter( "thread_decision" );
551 foreach( keys %request ) {
552 if( /^decision_(dir_[0-9a-z_]+)$/ ) {
553 $decision = $request{$&};
554 my $file= $1; # untainted
556 next if $request{'skip_submit'};
557 next if $decision eq 'skip';
559 my $waf= &article_file_name($1).'/stump-warning.txt';
560 if ($decision eq 'leave') {
561 my $now= time; defined $now or die $!;
562 utime $now,$now, $waf or $!==&ENOENT or die "$waf $!";
566 if ($decision eq 'consider') {
567 if (!open ADDWARN, '>>', $waf) {
568 $!==&ENOENT or die "$waf $!";
570 print ADDWARN "A moderator has marked this message for further consideration - please consult your comoderators before approving.\n" or die $!;
571 close ADDWARN or die $!;
576 die "$decision ?" unless $decision =~ m/^(approve|reject \w+)$/;
579 my $fullpath = &article_file_name( $file ) . "/stump-prolog.txt";
581 $decision = "reject thread" if $thread_decision eq "ban";
582 $decision = "approve" if $thread_decision eq "preapprove";
584 #$decision = "reject blocklist" if $poster_decision eq "ban";
585 die if $decision ne "approve" and $poster_decision eq "preapprove";
587 if( -r $fullpath && open( MESSAGE, "$fullpath" ) ) {
588 my $RealSubject = "", $From = "", $Subject = "";
590 if( /^Subject: /i ) {
593 $Subject =~ s/Subject: +//i;
594 } elsif( /^Real-Subject: /i ) {
597 $RealSubject =~ s/Real-Subject: +//i;
598 $RealSubject =~ s/Re: +//i;
599 } elsif( /^From: / ) {
602 $From =~ s/From: //i;
608 &add_to_config_file( "good.posters.list", $From )
609 if $poster_decision eq "preapprove";
611 &add_to_config_file( "good.subjects.list", $RealSubject )
612 if $thread_decision eq "preapprove";
614 &add_to_config_file( "watch.posters.list", $From )
615 if $poster_decision eq "suspicious";
617 &add_to_config_file( "bad.posters.list", $From )
618 if $poster_decision eq "ban";
620 &add_to_config_file( "bad.subjects.list", $RealSubject )
621 if $thread_decision eq "ban";
623 &add_to_config_file( "watch.subjects.list", $RealSubject )
624 if $thread_decision eq "watch";
626 # Subject, newsgroup, ShortDirectoryName, decision, comment
627 &process_approval_decision( $Subject, $newsgroup, $file, $decision, $comment, "moderator \U$request{'moderator'}" );
633 &html_moderation_screen;
636 # gets the count of unapproved articles sitting in the queue
637 sub get_article_count {
638 my $newsgroup = pop( @_ );
640 my $dir = &getQueueDir( $newsgroup );
641 opendir( DIR, $dir );
643 while( $file = readdir( DIR ) ) {
644 $count++ if( -d "$dir/$file" && $file ne "." && $file ne ".." && -r "$dir/$file/full_message.txt" );
650 # processes web request
651 sub processWebRequest {
653 my $action = $request{'action'};
654 my $newsgroup = $request{'newsgroup'};
655 my $moderator = $request{'moderator'};
656 my $password = $request{'password'};
658 $moderator = "\L$moderator";
660 if( $action eq "login_screen" ) {
662 } elsif( $action eq "moderation_screen" ) {
663 &authenticate( $newsgroup, $moderator, $password );
664 if( $moderator eq "admin" ) {
665 &html_newsgroup_management;
667 &html_moderation_screen;
669 } elsif( $action eq "moderator_admin" ) {
670 &authenticate( $newsgroup, $moderator, $password );
671 &html_newsgroup_management;
672 } elsif( $action eq "edit_list" ) {
673 &authenticate( $newsgroup, $moderator, $password );
674 &edit_configuration_list;
675 } elsif( $action eq "add_user" ) {
676 &authenticate( $newsgroup, $moderator, $password );
677 if( $moderator ne "admin" ) {
678 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
679 &user_error( "Only administrator (login ADMIN) can add or delete users" );
683 &html_newsgroup_management;
684 } elsif( $action eq "set_config_list" ) {
685 &authenticate( $newsgroup, $moderator, $password );
687 &html_newsgroup_management;
688 } elsif( $action eq "delete_user" ) {
689 &authenticate( $newsgroup, $moderator, $password );
690 if( $moderator ne "admin" ) {
691 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
692 &user_error( "Only administrator (login ADMIN) can add or delete users" );
695 &html_newsgroup_management;
696 } elsif( $action eq "approval_decision" ) {
697 &authenticate( $newsgroup, $moderator, $password );
698 if( $moderator eq "admin" ) {
699 &user_error( "Login ADMIN exists for user management only" );
702 } elsif( $action eq "moderate_article" ) {
703 &authenticate( $newsgroup, $moderator, $password );
704 if( $moderator eq "admin" ) {
705 &user_error( "Login ADMIN exists for user management only" );
707 &html_moderate_article();
708 } elsif( $action eq "change_password" ) {
709 &authenticate( $newsgroup, $moderator, $password );
710 &html_change_password;
711 } elsif( $action eq "search_logs" ) {
712 &authenticate( $newsgroup, $moderator, $password );
714 } elsif( $action eq "validate_change_password" ) {
715 &authenticate( $newsgroup, $moderator, $password );
716 &validate_change_password;
717 # } elsif( $action eq "init_request_newsgroup_creation" ) {
718 # &init_request_newsgroup_creation;
719 # } elsif( $action eq "complete_newsgroup_creation_request" ) {
720 # &complete_newsgroup_creation_request;
721 } elsif( $action eq "webstump_admin_screen" ) {
722 &webstump_admin_screen;
723 } elsif( $action eq "admin_login" ) {
725 } elsif( $action eq "admin_add_newsgroup" ) {
726 &admin_add_newsgroup;
727 } elsif( $action eq "help" ) {
730 &error( "Unknown user action: '$action'" );