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";
193 &error( "Invalid entry $_ in the newsgroups database." )
194 if( !$ng || !$addr );
195 push @newsgroups_array,$ng;
196 $newsgroups_index{$ng} = "$addr";
200 open( LOG, ">>$webstump_home/log/webstump.log" );
201 print LOG "Call from $ENV{'REMOTE_ADDR'}, QUERY_STRING=$ENV{'QUERY_STRING'}\n";
204 # gets the directory name for the newsgroup
206 my $newsgroup = pop( @_ );
207 if( $newsgroups_index{$newsgroup} ) {
208 return "$queues_dir/$newsgroup";
210 return ""; # undefined ng
213 # reads request, if any
217 if( defined $ENV{"QUERY_STRING"} ) {
219 @query = split( /&/, $ENV{"QUERY_STRING"} );
221 my ($name, $value) = split( /=/ );
222 $result{&unescape($name)} = &unescape( $value );
227 @query = split( /&/, $_ );
229 my ($name, $value) = split( /=/ );
230 $result{&unescape($name)} = &unescape( $value );
234 foreach( keys %result ) {
235 print LOG "Request: $_ = $result{$_}\n" if( $_ ne "password" );
240 # Checks if the program is running in a demo mode
242 return &optional_parameter( 'newsgroup' ) eq "demo.newsgroup"
243 && !$ignore_demo_mode;
246 # opens file for writing
247 sub open_file_for_writing { # filehandle, filename
248 my $filename = pop( @_ );
249 my $filehandle = pop( @_ );
251 if( &is_demo_mode ) {
252 return( open( $filehandle, ">/dev/null" ) );
254 return( open( $filehandle, ">$filename" ) );
258 # opens pipe for writing
259 sub open_pipe_for_writing { # filehandle, filename
260 my $filename = pop( @_ );
261 my $filehandle = pop( @_ );
263 if( &is_demo_mode ) {
264 return( open( $filehandle, ">/dev/null" ) );
266 return( open( $filehandle, "|$filename" ) );
270 # opens file for appending
271 sub open_file_for_appending { # filehandle, filename
272 my $filename = pop( @_ );
273 my $filehandle = pop( @_ );
275 if( &is_demo_mode ) {
276 return( open( $filehandle, ">>/dev/null" ) );
278 return( open( $filehandle, ">>$filename" ) );
285 return "" if( ! defined $request{$arg} );
286 return $request{$arg};
289 # barfs if the required parameter is not supplied
290 sub required_parameter {
292 user_error( "Parameter \"$arg\" is not defined or is empty" )
293 if( ! defined $request{$arg} || !$request{$arg} );
294 return $request{$arg};
297 # optional request parameter
298 sub optional_parameter {
300 return $request{$arg};
303 # issues a security alert
306 print LOG "SECURITY_ALERT: $msg\n";
309 # reads the moderators info
310 sub read_moderators {
311 my $newsgroup = &required_parameter( "newsgroup" );
313 my $file = &full_config_file_name( "moderators" );
315 open( MODERATORS, "$file" )
316 || error( "Could not open file with moderator passwords: $file" );
318 while( <MODERATORS> ) {
319 my ($name, $pwd) = split;
320 $moderators{"\U$name"} = "\U$pwd";
326 # saves the moderators info
327 sub save_moderators {
328 my $newsgroup = &required_parameter( "newsgroup" );
330 my $file = &full_config_file_name( "moderators" );
332 open_file_for_writing( MODERATORS, $file );
333 # || &error( "Could not open file with moderator passwords: $file" );
335 foreach (keys %moderators) {
336 print MODERATORS "$_ $moderators{$_}\n";
344 my $password = &required_parameter( "password" );
345 my $moderator = &required_parameter( "moderator" );
346 my $newsgroup = &required_parameter( "newsgroup" );
350 if( !defined $moderators{"\U$moderator"} ||
351 $moderators{"\U$moderator"} ne "\U$password" ) {
352 &security_alert( "Authentication denied." )
353 &user_error( "Authentication denied." );
357 # cleans request of dangerous characters
358 sub disinfect_request {
359 if( defined $request{'newsgroup'} ) {
360 $newsgroup = $request{'newsgroup'};
361 $newsgroup =~ m/^(\w[.0-9a-z+]+)$/ or die;
363 $request{'newsgroup'} = $newsgroup;
366 if( defined $request{'file'} ) {
367 my $file = $request{'file'};
368 $file =~ m/^\w[.0-9a-z]+\.list$|^dir_\d+_\d+$/ or die "$file ?";
370 $request{'file'} = $file;
376 my $user = &required_parameter( "user" );
377 my $new_password = &required_parameter( "new_password" );
379 &user_error( "Username may only contain letters and digits" )
380 if( ! ($user =~ /^[a-zA-Z0-9]+$/ ) );
381 &user_error( "Password may only contain letters and digits" )
382 if( ! ($new_password =~ /^[a-zA-Z0-9]+$/ ) );
383 &user_error( "Cannot change password for user admin" )
384 if( "\U$user" eq "ADMIN" );
386 $moderators{"\U$user"} = "\U$new_password";
391 # checks that a config list is in enumerated set of values. Returns
393 sub check_config_list {
394 my $list_to_edit = pop( @_ );
396 &user_error( "invalid list name $list_to_edit" )
397 if( $list_to_edit ne "good.posters.list"
398 && $list_to_edit ne "watch.posters.list"
399 && $list_to_edit ne "bad.posters.list"
400 && $list_to_edit ne "good.subjects.list"
401 && $list_to_edit ne "watch.subjects.list"
402 && $list_to_edit ne "bad.subjects.list"
403 && $list_to_edit ne "bad.words.list"
404 && $list_to_edit ne "watch.words.list" );
406 return &untaint( $list_to_edit );
409 # sets a configuration list (good posters etc)
410 sub set_config_list {
411 my $list_content = $request{"list"};
412 my $list_to_edit = &required_parameter( "list_to_edit" );
414 $list_content .= "\n";
415 $list_content =~ s/\r//g;
416 $list_content =~ s/\n+/\n/g;
417 $list_content =~ s/\n +/\n/g;
418 $list_content =~ s/^\n+//g;
420 $list_to_edit = &check_config_list( $list_to_edit );
422 my $list_file = &full_config_file_name( $list_to_edit );
424 open_file_for_writing( LIST, "$list_file.new" )
425 || &error( "Could not open $list_file for writing" );
426 print LIST $list_content;
429 report_list_diff("$list_to_edit", sub {
431 my $child= fork; die unless defined $child;
433 open STDOUT, '>&DIFF' or die $!;
434 exec 'diff','-u','-L', "$list_to_edit.old",'-L', "$list_to_edit.new",'--', "$list_file","$list_file.new";
437 waitpid($child,0) == $child or die "$list_file $!";
438 $?==0 or $?==256 or die "$list_file $?";
441 rename ("$list_file.new", "$list_file");
446 my $user = &required_parameter( "user" );
448 &user_error( "User \U$user" . " does not exist!" )
449 if( ! defined $moderators{"\U$user"} );
450 &user_error( "Cannot delete user admin" )
451 if( "\U$user" eq "ADMIN" );
453 delete $moderators{"\U$user"};
458 # validate password change
459 sub validate_change_password {
460 my $user = &required_parameter( "moderator" );
461 my $new_password = &required_parameter( "new_password" );
463 &user_error( "Password may only contain letters and digits" )
464 if( ! ($new_password =~ /^[a-zA-Z0-9]+$/ ) );
465 &user_error( "Cannot change password for user admin" )
466 if( "\U$user" eq "ADMIN" );
468 $moderators{"\U$user"} = "\U$new_password";
474 # reads rejection reasons
475 sub read_rejection_reasons {
476 my $newsgroup = &required_parameter( 'newsgroup' );
477 my $reasons = &full_config_file_name( "rejection-reasons" );
478 open( REASONS, $reasons ) || &error( "Could not open file $reasons" );
482 my ($name, $title) = split( /::/ );
483 $rejection_reasons{$name} = $title;
484 push @short_rejection_reasons, $name;
494 foreach (@sendmail) {
501 &error( "Sendmail not found" ) if( !$sendmail );
506 # email_message message recipient
508 my $recipient = pop( @_ );
509 my $message = pop( @_ );
510 my $sendmail= find_sendmail;
511 my $sendmail_command = "$sendmail $recipient";
512 $sendmail_command =~ /(^.*$)/;
513 $sendmail_command = $1; # untaint
514 open_pipe_for_writing( SENDMAIL, "$sendmail_command > /dev/null " );
515 print SENDMAIL $message;
520 sub article_file_name {
521 my $file = pop( @_ );
522 return "$queues_dir/$newsgroup/$file";
534 return if &is_demo_mode;
536 opendir( DIR, $dir ) || return;
537 while( $_ = readdir(DIR) ) {
538 unlink &untaint( "$dir/$_" );
544 sub approval_decision {
545 $newsgroup = &required_parameter( 'newsgroup' );
546 my $comment = &get_parameter( 'comment' );
549 my $poster_decision = &optional_parameter( "poster_decision" );
550 my $thread_decision = &optional_parameter( "thread_decision" );
552 foreach( keys %request ) {
553 if( /^decision_(dir_[0-9a-z_]+)$/ ) {
554 $decision = $request{$&};
555 my $file= $1; # untainted
557 next if $request{'skip_submit'};
558 next if $decision eq 'skip';
560 my $waf= &article_file_name($1).'/stump-warning.txt';
561 if ($decision eq 'leave') {
562 my $now= time; defined $now or die $!;
563 utime $now,$now, $waf or $!==&ENOENT or die "$waf $!";
567 if ($decision eq 'consider') {
568 if (!open ADDWARN, '>>', $waf) {
569 $!==&ENOENT or die "$waf $!";
571 print ADDWARN "A moderator has marked this message for further consideration - please consult your comoderators before approving.\n" or die $!;
572 close ADDWARN or die $!;
577 die "$decision ?" unless $decision =~ m/^(approve|reject \w+)$/;
580 my $fullpath = &article_file_name( $file ) . "/stump-prolog.txt";
582 $decision = "reject thread" if $thread_decision eq "ban";
583 $decision = "approve" if $thread_decision eq "preapprove";
585 $decision = "reject abuse" if $poster_decision eq "ban";
586 $decision = "approve" if $poster_decision eq "preapprove";
588 if( -r $fullpath && open( MESSAGE, "$fullpath" ) ) {
589 my $RealSubject = "", $From = "", $Subject = "";
591 if( /^Subject: /i ) {
594 $Subject =~ s/Subject: +//i;
595 } elsif( /^Real-Subject: /i ) {
598 $RealSubject =~ s/Real-Subject: +//i;
599 $RealSubject =~ s/Re: +//i;
600 } elsif( /^From: / ) {
603 $From =~ s/From: //i;
609 &add_to_config_file( "good.posters.list", $From )
610 if $poster_decision eq "preapprove";
612 &add_to_config_file( "good.subjects.list", $RealSubject )
613 if $thread_decision eq "preapprove";
615 &add_to_config_file( "watch.posters.list", $From )
616 if $poster_decision eq "suspicious";
618 &add_to_config_file( "bad.posters.list", $From )
619 if $poster_decision eq "ban";
621 &add_to_config_file( "bad.subjects.list", $RealSubject )
622 if $thread_decision eq "ban";
624 &add_to_config_file( "watch.subjects.list", $RealSubject )
625 if $thread_decision eq "watch";
627 # Subject, newsgroup, ShortDirectoryName, decision, comment
628 &process_approval_decision( $Subject, $newsgroup, $file, $decision, $comment );
634 &html_moderation_screen;
637 # gets the count of unapproved articles sitting in the queue
638 sub get_article_count {
639 my $newsgroup = pop( @_ );
641 my $dir = &getQueueDir( $newsgroup );
642 opendir( DIR, $dir );
644 while( $file = readdir( DIR ) ) {
645 $count++ if( -d "$dir/$file" && $file ne "." && $file ne ".." && -r "$dir/$file/full_message.txt" );
651 # processes web request
652 sub processWebRequest {
654 my $action = $request{'action'};
655 my $newsgroup = $request{'newsgroup'};
656 my $moderator = $request{'moderator'};
657 my $password = $request{'password'};
659 $moderator = "\L$moderator";
661 if( $action eq "login_screen" ) {
663 } elsif( $action eq "moderation_screen" ) {
664 &authenticate( $newsgroup, $moderator, $password );
665 if( $moderator eq "admin" ) {
666 &html_newsgroup_management;
668 &html_moderation_screen;
670 } elsif( $action eq "moderator_admin" ) {
671 &authenticate( $newsgroup, $moderator, $password );
672 &html_newsgroup_management;
673 } elsif( $action eq "edit_list" ) {
674 &authenticate( $newsgroup, $moderator, $password );
675 &edit_configuration_list;
676 } elsif( $action eq "add_user" ) {
677 &authenticate( $newsgroup, $moderator, $password );
678 if( $moderator ne "admin" ) {
679 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
680 &user_error( "Only administrator (login ADMIN) can add or delete users" );
684 &html_newsgroup_management;
685 } elsif( $action eq "set_config_list" ) {
686 &authenticate( $newsgroup, $moderator, $password );
688 &html_newsgroup_management;
689 } elsif( $action eq "delete_user" ) {
690 &authenticate( $newsgroup, $moderator, $password );
691 if( $moderator ne "admin" ) {
692 &security_alert( "Moderator $moderator tried to add user in $newsgroup" );
693 &user_error( "Only administrator (login ADMIN) can add or delete users" );
696 &html_newsgroup_management;
697 } elsif( $action eq "approval_decision" ) {
698 &authenticate( $newsgroup, $moderator, $password );
699 if( $moderator eq "admin" ) {
700 &user_error( "Login ADMIN exists for user management only" );
703 } elsif( $action eq "moderate_article" ) {
704 &authenticate( $newsgroup, $moderator, $password );
705 if( $moderator eq "admin" ) {
706 &user_error( "Login ADMIN exists for user management only" );
708 &html_moderate_article();
709 } elsif( $action eq "change_password" ) {
710 &authenticate( $newsgroup, $moderator, $password );
711 &html_change_password;
712 } elsif( $action eq "validate_change_password" ) {
713 &authenticate( $newsgroup, $moderator, $password );
714 &validate_change_password;
715 # } elsif( $action eq "init_request_newsgroup_creation" ) {
716 # &init_request_newsgroup_creation;
717 # } elsif( $action eq "complete_newsgroup_creation_request" ) {
718 # &complete_newsgroup_creation_request;
719 } elsif( $action eq "webstump_admin_screen" ) {
720 &webstump_admin_screen;
721 } elsif( $action eq "admin_login" ) {
723 } elsif( $action eq "admin_add_newsgroup" ) {
724 &admin_add_newsgroup;
725 } elsif( $action eq "help" ) {
728 &error( "Unknown user action: '$action'" );