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 "good.subjects.list"
403 && $list_to_edit ne "watch.subjects.list"
404 && $list_to_edit ne "bad.subjects.list"
405 && $list_to_edit ne "bad.words.list"
406 && $list_to_edit ne "watch.words.list" );
408 return &untaint( $list_to_edit );
411 # sets a configuration list (good posters etc)
412 sub set_config_list {
413 my $list_content = $request{"list"};
414 my $list_to_edit = &required_parameter( "list_to_edit" );
416 $list_content .= "\n";
417 $list_content =~ s/\r//g;
418 $list_content =~ s/\n+/\n/g;
419 $list_content =~ s/\n +/\n/g;
420 $list_content =~ s/^\n+//g;
422 $list_to_edit = &check_config_list( $list_to_edit );
424 my $list_file = &full_config_file_name( $list_to_edit );
426 open_file_for_writing( LIST, "$list_file.new" )
427 || &error( "Could not open $list_file for writing" );
428 print LIST $list_content;
431 report_list_diff("$list_to_edit", sub {
433 my $child= fork; die unless defined $child;
435 open STDOUT, '>&DIFF' or die $!;
436 exec 'diff','-u','-L', "$list_to_edit.old",'-L', "$list_to_edit.new",'--', "$list_file","$list_file.new";
439 waitpid($child,0) == $child or die "$list_file $!";
440 $?==0 or $?==256 or die "$list_file $?";
443 rename ("$list_file.new", "$list_file");
448 my $user = &required_parameter( "user" );
450 &user_error( "User \U$user" . " does not exist!" )
451 if( ! defined $moderators{"\U$user"} );
452 &user_error( "Cannot delete user admin" )
453 if( "\U$user" eq "ADMIN" );
455 delete $moderators{"\U$user"};
460 # validate password change
461 sub validate_change_password {
462 my $user = &required_parameter( "moderator" );
463 my $new_password = &required_parameter( "new_password" );
465 &user_error( "Password may only contain letters and digits" )
466 if( ! ($new_password =~ /^[a-zA-Z0-9]+$/ ) );
467 &user_error( "Cannot change password for user admin" )
468 if( "\U$user" eq "ADMIN" );
470 $moderators{"\U$user"} = "\U$new_password";
476 # reads rejection reasons
477 sub read_rejection_reasons {
478 my $newsgroup = &required_parameter( 'newsgroup' );
479 my $reasons = &full_config_file_name( "rejection-reasons" );
480 open( REASONS, $reasons ) || &error( "Could not open file $reasons" );
484 my ($name, $title) = split( /::/ );
485 $rejection_reasons{$name} = $title;
486 push @short_rejection_reasons, $name;
496 foreach (@sendmail) {
503 &error( "Sendmail not found" ) if( !$sendmail );
508 # email_message message recipient
510 my $recipient = pop( @_ );
511 my $message = pop( @_ );
512 my $sendmail= find_sendmail;
513 my $sendmail_command = "$sendmail $recipient";
514 $sendmail_command =~ /(^.*$)/;
515 $sendmail_command = $1; # untaint
516 open_pipe_for_writing( SENDMAIL, "$sendmail_command > /dev/null " )
518 print SENDMAIL $message or die $!;
519 close( SENDMAIL ) or die "$? $!";
523 sub article_file_name {
524 my $file = pop( @_ );
525 return "$queues_dir/$newsgroup/$file";
537 return if &is_demo_mode;
539 opendir( DIR, $dir ) || return;
540 while( $_ = readdir(DIR) ) {
541 unlink &untaint( "$dir/$_" );
547 sub approval_decision {
548 $newsgroup = &required_parameter( 'newsgroup' );
549 my $comment = &get_parameter( 'comment' );
552 my $poster_decision = &optional_parameter( "poster_decision" );
553 my $thread_decision = &optional_parameter( "thread_decision" );
555 foreach( keys %request ) {
556 if( /^decision_(dir_[0-9a-z_]+)$/ ) {
557 $decision = $request{$&};
558 my $file= $1; # untainted
560 next if $request{'skip_submit'};
561 next if $decision eq 'skip';
563 my $waf= &article_file_name($1).'/stump-warning.txt';
564 if ($decision eq 'leave') {
565 my $now= time; defined $now or die $!;
566 utime $now,$now, $waf or $!==&ENOENT or die "$waf $!";
570 if ($decision eq 'consider') {
571 if (!open ADDWARN, '>>', $waf) {
572 $!==&ENOENT or die "$waf $!";
574 print ADDWARN "A moderator has marked this message for further consideration - please consult your comoderators before approving.\n" or die $!;
575 close ADDWARN or die $!;
580 die "$decision ?" unless $decision =~ m/^(approve|reject \w+)$/;
583 my $fullpath = &article_file_name( $file ) . "/stump-prolog.txt";
585 $decision = "reject thread" if $thread_decision eq "ban";
586 $decision = "approve" if $thread_decision eq "preapprove";
588 $decision = "reject abuse" if $poster_decision eq "ban";
589 $decision = "approve" if $poster_decision eq "preapprove";
591 if( -r $fullpath && open( MESSAGE, "$fullpath" ) ) {
592 my $RealSubject = "", $From = "", $Subject = "";
594 if( /^Subject: /i ) {
597 $Subject =~ s/Subject: +//i;
598 } elsif( /^Real-Subject: /i ) {
601 $RealSubject =~ s/Real-Subject: +//i;
602 $RealSubject =~ s/Re: +//i;
603 } elsif( /^From: / ) {
606 $From =~ s/From: //i;
612 &add_to_config_file( "good.posters.list", $From )
613 if $poster_decision eq "preapprove";
615 &add_to_config_file( "good.subjects.list", $RealSubject )
616 if $thread_decision eq "preapprove";
618 &add_to_config_file( "watch.posters.list", $From )
619 if $poster_decision eq "suspicious";
621 &add_to_config_file( "bad.posters.list", $From )
622 if $poster_decision eq "ban";
624 &add_to_config_file( "bad.subjects.list", $RealSubject )
625 if $thread_decision eq "ban";
627 &add_to_config_file( "watch.subjects.list", $RealSubject )
628 if $thread_decision eq "watch";
630 # Subject, newsgroup, ShortDirectoryName, decision, comment
631 &process_approval_decision( $Subject, $newsgroup, $file, $decision, $comment );
637 &html_moderation_screen;
640 # gets the count of unapproved articles sitting in the queue
641 sub get_article_count {
642 my $newsgroup = pop( @_ );
644 my $dir = &getQueueDir( $newsgroup );
645 opendir( DIR, $dir );
647 while( $file = readdir( DIR ) ) {
648 $count++ if( -d "$dir/$file" && $file ne "." && $file ne ".." && -r "$dir/$file/full_message.txt" );
654 # processes web request
655 sub processWebRequest {
657 my $action = $request{'action'};
658 my $newsgroup = $request{'newsgroup'};
659 my $moderator = $request{'moderator'};
660 my $password = $request{'password'};
662 $moderator = "\L$moderator";
664 if( $action eq "login_screen" ) {
666 } elsif( $action eq "moderation_screen" ) {
667 &authenticate( $newsgroup, $moderator, $password );
668 if( $moderator eq "admin" ) {
669 &html_newsgroup_management;
671 &html_moderation_screen;
673 } elsif( $action eq "moderator_admin" ) {
674 &authenticate( $newsgroup, $moderator, $password );
675 &html_newsgroup_management;
676 } elsif( $action eq "edit_list" ) {
677 &authenticate( $newsgroup, $moderator, $password );
678 &edit_configuration_list;
679 } elsif( $action eq "add_user" ) {
680 &authenticate( $newsgroup, $moderator, $password );
681 if( $moderator ne "admin" ) {
682 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
683 &user_error( "Only administrator (login ADMIN) can add or delete users" );
687 &html_newsgroup_management;
688 } elsif( $action eq "set_config_list" ) {
689 &authenticate( $newsgroup, $moderator, $password );
691 &html_newsgroup_management;
692 } elsif( $action eq "delete_user" ) {
693 &authenticate( $newsgroup, $moderator, $password );
694 if( $moderator ne "admin" ) {
695 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
696 &user_error( "Only administrator (login ADMIN) can add or delete users" );
699 &html_newsgroup_management;
700 } elsif( $action eq "approval_decision" ) {
701 &authenticate( $newsgroup, $moderator, $password );
702 if( $moderator eq "admin" ) {
703 &user_error( "Login ADMIN exists for user management only" );
706 } elsif( $action eq "moderate_article" ) {
707 &authenticate( $newsgroup, $moderator, $password );
708 if( $moderator eq "admin" ) {
709 &user_error( "Login ADMIN exists for user management only" );
711 &html_moderate_article();
712 } elsif( $action eq "change_password" ) {
713 &authenticate( $newsgroup, $moderator, $password );
714 &html_change_password;
715 } elsif( $action eq "validate_change_password" ) {
716 &authenticate( $newsgroup, $moderator, $password );
717 &validate_change_password;
718 # } elsif( $action eq "init_request_newsgroup_creation" ) {
719 # &init_request_newsgroup_creation;
720 # } elsif( $action eq "complete_newsgroup_creation_request" ) {
721 # &complete_newsgroup_creation_request;
722 } elsif( $action eq "webstump_admin_screen" ) {
723 &webstump_admin_screen;
724 } elsif( $action eq "admin_login" ) {
726 } elsif( $action eq "admin_add_newsgroup" ) {
727 &admin_add_newsgroup;
728 } elsif( $action eq "help" ) {
731 &error( "Unknown user action: '$action'" );