#!/usr/bin/perl =head1 NAME BBS.cgi - a sample BBS script for the CGI_Board class library Version: 0.70 + Virtual Avenue patch 0.02 (beta test version) Date: Sat May 12 04:29:40 JST 2001 =head1 Copyright Copyright (c) 1998 1999 2000 2001 KUROKI Gen Permission to use, copy, and distribute is hereby granted, only providing that the above copyright notice and this permission appear in all copies and in supporting documentation. =cut #============================================================================== # Location of CGI_Board my $Version_of_CGI_Board = "0.70+VA0.02"; my $URL_of_CGI_Board = "http://www.math.tohoku.ac.jp/~kuroki/pub/CGI_Board/"; my $Link_to_CGI_Board = qq!CGI_Board $Version_of_CGI_Board!; #------------------------------------------------------------------------------ # # Advertising Banner use vars qw( $Banner ); #$Banner = ""; # # for Virtual Avenue # $Banner .= "\n\n"; $Banner .= "\n"; # # for Tytek # #require 'advsetup.pl'; #$Banner .= "\n\n"; #============================================================================== # Load modules and set $Script_File, etc # Set $Script_File, $Script_Dir and $Script_Filename. # (e.g.: If $Script_File eq "/home/name/somedir/BBS.cgi", then # $Script_Dir = "/home/name/somedir" and $Script_Filename = "BBS.cgi".) # my ($Script_File, $Script_Dir, $Script_Filename); BEGIN { require 5.004; if (defined $ENV{'SCRIPT_FILENAME'}) { $Script_File = $ENV{'SCRIPT_FILENAME'}; } else { $Script_File = $0; } chmod 0711, $Script_File; ($Script_Dir, $Script_Filename) = ($Script_File =~ m!^(.*)/(.*?)$!); $Script_Dir = "." unless defined $Script_Dir; $Script_Filename = $Script_File unless defined $Script_Filename; chdir $Script_Dir or die "chdir $Script_Dir: $!"; } # Location of CGI_Board modules and jcode.pl # use lib qw( . ./lib .. ../lib ); #use lib qw( /home/name/lib/perl ); # Load modules # use CGI_Board; use CGI_Board::Misc qw( check_access check_satisfy check_allow check_require check_html macroexpand localdate quotehtml quotequot quotecomm unquotecomm makelink randsalt passwdmatch filelock fileunlock sprintvar ); # Use strict! # use strict; #============================================================================== # # ****************** Change the following appropriately! ****************** # # Directories and Permissions # # Default Setting: # # (1) $Script_Dir/ # (2) $Script_Dir/Config/ # (3) Permission of Direcotries: 0777 # (4) Permission of Files: 0666 # Set default permissions. # # Permission of directories and files # #my $Perm_Config_Dir = 0777; #my $Perm_Board_Dir = 0777; #my $Perm_Syslog = 0666; #my $Perm_Admin = 0666; #my $Perm_Config = 0666; #my $Perm_Board = 0666; #my $Perm_Boardlog = 0666; #my $Perm_Searchlog = 0666; #my $Perm_Errorlog = 0666; # my $Perm_Config_Dir = 0700; my $Perm_Board_Dir = 0755; my $Perm_Syslog = 0600; my $Perm_Admin = 0600; my $Perm_Config = 0600; my $Perm_Board = 0644; my $Perm_Boardlog = 0600; my $Perm_Searchlog = 0600; my $Perm_Errorlog = 0600; # Set the directory in which configuration files are placed. # If its first character is not "/", it is interpreted as the relative path # from $Script_Dir. (e.g.: If $Script_Dir eq "/home/name/somedir/", then # $BBS_Config_Dir eq "../Config" is interpreted as "/home/name/Config". # my $BBS_Config_Dir = "Config"; #my $BBS_Config_Dir = "/home/name/Config"; # absolute path # # Set the permission of $BBS_Config_Dir. # my $BBS_Config_Dir_Perm = $Perm_Config_Dir; # Set the directory in which board files are placed. # If its first character is not "/", it is interpreted as the relative path # from $Script_Dir. (e.g.: If $Script_Dir eq "/home/name/dir/", then # $BBS_Board_Dir eq "Spool" is interpreted as "/home/name/somedir/Spool". # my $BBS_Board_Dir_URL = "."; my $BBS_Board_Dir = "."; #my $BBS_Board_Dir_URL = "/~name/bbs"; # dirname in URL #my $BBS_Board_Dir = "/home/name/public_html/bbs"; # absolute path # # Set the permission of $BBS_Board_Dir. # my $BBS_Board_Dir_Perm = $Perm_Board_Dir; # Set the URL of this script. # my $BBS_CGI_URL = $Script_Filename; #my $BBS_CGI_URL = $ENV{'SCRIPT_NAME'}; # Set the URL of "READ.cgi" script # my $READ_CGI_URL = $BBS_CGI_URL; #(my $READ_CGI_URL = $ENV{'SCRIPT_NAME'}) =~ s,[^/]*$,READ.cgi,; # Set DirectoryIndex filename. # #my $DirectoryIndex = "index.html"; my $DirectoryIndex = undef; # Check disk space # #my $df_command = "df"; #$df_command = "/usr/ucb/df" if -x "/usr/ucb/df"; #my $df_dir = $BBS_Board_Dir; #my @df_result = `$df_command $df_dir`; #my $capacity = (split " ", $df_result[1])[4]; #if ($capacity > 99) { # print "Content-Type: text/plain\n\n"; # print @df_result; # print "\nDon't use $Script_Filename because the file sysytem is full.\n"; # exit; #} # # ******************* Change the above appropriately! ******************** # #============================================================================== # CGI formdata my $cgi = CGI_Board->new; $cgi->parse_formdata; my $cgi_value = $cgi->last_value_index; my %cgi_value = %$cgi_value if defined $cgi_value; my $cgi_userid = $cgi_value{'userid'}; my $cgi_passwd = $cgi_value{'passwd'}; #============================================================================== # Make directories and "index.html" unless (-e $BBS_Board_Dir) { mkdir $BBS_Board_Dir, $Perm_Board_Dir or print_and_die(sprintf("mkdir %s, %o: %s", $BBS_Board_Dir, $BBS_Board_Dir_Perm, $!)); chmod $Perm_Board_Dir, $BBS_Board_Dir; } unless (-d $BBS_Board_Dir) { print_and_die("$BBS_Board_Dir: not a directory"); } if (defined $DirectoryIndex && ! -f $BBS_Board_Dir . "/" . $DirectoryIndex) { open INDEX, ">" . $BBS_Board_Dir . "/" . $DirectoryIndex or print_and_die($BBS_Board_Dir . "/" . $DirectoryIndex, ": $!"); print INDEX ""; close INDEX; chmod $Perm_Board, $BBS_Board_Dir . "/" . $DirectoryIndex; } unless (-e $BBS_Config_Dir) { mkdir $BBS_Config_Dir, $Perm_Config_Dir or print_and_die(sprintf("mkdir %s, %o: %s", $BBS_Config_Dir, $BBS_Config_Dir_Perm, $!)); chmod $Perm_Config_Dir, $BBS_Config_Dir; } unless (-d $BBS_Config_Dir) { print_and_die("$BBS_Config_Dir: not a directory"); } if (defined $DirectoryIndex && ! -f $BBS_Config_Dir . "/" . $DirectoryIndex) { open INDEX, ">" . $BBS_Config_Dir . "/" . $DirectoryIndex or print_and_die($BBS_Config_Dir . "/" . $DirectoryIndex, ": $!"); print INDEX ""; close INDEX; chmod $Perm_Board, $BBS_Config_Dir . "/" . $DirectoryIndex; } #============================================================================== # Syslog and Errorlog files # Syslog file my $syslog_dir = $BBS_Config_Dir; my $syslog_filename = "Syslog.cgi"; my $syslog_file = $syslog_dir . "/" . $syslog_filename; my $syslog_perm = $Perm_Syslog; my $syslog_maxsize = 500 * 1024; # To stop logging syslog, let $syslog_file be undef. #my $syslog_file = undef; # Errorlog file my $errorlog_dir = $syslog_dir; my $errorlog_filename = "Error.cgi"; my $errorlog_file = $errorlog_dir . "/" . $errorlog_filename; my $errorlog_perm = $Perm_Errorlog; my $errorlog_maxsize = 100 * 1024; # To stop logging errors, let $errorlog_file be undef. #my $errorlog_file = undef; # Rentallog file my $rentallog_file = $syslog_dir . "/Rental_log.cgi"; #============================================================================== # Default board configuration #------------------------------------------------------------------------------ my $inputform_passwd = inputform_passwd(); #------------------------------------------------------------------------------ my $Default_Board_Suffix = ".html"; my $Default_Body_Tag = qq||; my $Default_Rule = qq|
|; my $Default_Dash = qq|
|; #------------------------------------------------------------------------------ my $Default_Footer = <<"----------END;"; %{HR} %{OWNER_NAME} %{IF|OWNER_EMAIL|<%{OWNER_EMAIL}> |}%{IF|OWNER_WEBSITE|(Web Site) |}%{HR}
%{CGI_Board}
----------END; chomp $Default_Footer; my $Default_Admin_Footer = <<"----------END;"; $Default_Rule
$Link_to_CGI_Board
----------END; chomp $Default_Admin_Footer; #------------------------------------------------------------------------------ my $Default_Board_Header = <<"----------END;"; %{TITLE} %{BODY_TAG} %{BANNER} %{HR}

%{TITLE} (%{SEQ})

Submit, Normal Order, Thread, Search, Old, Recent%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

----------END; #------------------------------------------------------------------------------ my $Default_Board_Footer = <<"----------END;"; %{IF|STAT_NEXT|%{HR}

%{TITLE}%{PREVIOUS_SEQ}

    %{ARTICLE_INDEX}
|}%{FOOTER} ----------END; #------------------------------------------------------------------------------ my $Default_Article_Format = <<"----------END;"; # html Id: #%{ID} (reply, thread)
Date: %{DATE_E}
%{IF|replyto|In-Reply-To: %{LINK|replyto|replyto}
|}%{IF|url|Name: %{LINK|name|url}
|Name: %{name}
}%{IF|subject|Subject: %{subject}
|}
%{body}%{file} # pre Id: #%{ID} (reply, thread)
Date: %{DATE_E}
%{IF|replyto|In-Reply-To: %{PLAIN|replyto}
|}%{IF|url|URL: %{LINK|url|url}
|}Name: %{PLAIN|name}
%{IF|subject|Subject: %{PLAIN|subject}
|}
%{PLAIN|body}%{PLAIN|file}
----------END; chomp $Default_Article_Format; #------------------------------------------------------------------------------ my $Default_Submission_Form = <<"----------END;"; %{TITLE}: Submission Form %{BODY_TAG} %{BANNER} %{HR}

%{TITLE}: Submission Form

Read, Thread, Search, Old%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

%{IF|FORMATTED_ARTICLE|%{HR}

Preview and Submission

Do you submit the article bellow? / No

%{FORMATTED_ARTICLE}
|}%{IF|CHECK_HTML_ERROR|%{HR}

Error

%{PLAIN|CHECK_HTML_ERROR}
%{HR}

Hint

%{PLAIN|CHECK_HTML_HINT}
|}%{HR}

Input Form

application/x-www-form-urlencoded

Name:

E-mail Address or URL of Web Site:

In-Reply-To (e.g. %{CURRENT}#%{ID}):

Subject:

Body:




multipart/form-data

Name:

E-mail Address or URL of Web Site:

In-Reply-To (e.g. %{CURRENT}#%{ID}):

Subject:

Upload File:



%{FOOTER} ----------END; #------------------------------------------------------------------------------ my $Default_Submission_Completed = <<"----------END;"; %{TITLE}: Submission Completed %{BODY_TAG} %{BANNER} %{HR}

%{TITLE}: Submission Completed

Read, Search, Old%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

%{HR}

Submitted Article

%{FORMATTED_ARTICLE} %{FOOTER} ----------END; chomp $Default_Submission_Completed; #------------------------------------------------------------------------------ my $Default_Search_Header = <<"----------END;"; %{IF|k|%{TITLE}: Search Results for "%{k}" |%{TITLE}: Search }%{BODY_TAG} %{BANNER} %{HR} %{IF|k|

%{TITLE}: Search Results for "%{k}"

|

%{TITLE}: Search

}

Read, Submit, Thread, Old%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

%{HR}

Search

Expression:
Order: Output:
Range: (e.g.: 13-19, -23, 7-, 11)

%{IF|k|%{HR}

Search Results for "%{k}"

|} ----------END; chomp $Default_Search_Header; #------------------------------------------------------------------------------ my $Default_Old_Logs_Header = <<"----------END;"; %{TITLE}: Old Logs %{r} %{BODY_TAG} %{BANNER} %{HR}

%{TITLE}: Old Logs %{r}

Read, Submit, Thread, Search%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

----------END; chomp $Default_Old_Logs_Header; #------------------------------------------------------------------------------ my $Default_Thread_Header = <<"----------END;"; %{TITLE}: Threaded Index %{BODY_TAG} %{BANNER} %{HR}

%{TITLE}: Threaded Index

%{CASE|o|Normal Order, |Reverse Order, }Read, Submit, Search, Old%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

----------END; chomp $Default_Thread_Header; #------------------------------------------------------------------------------ my $Default_Index_Header = <<"----------END;"; %{TITLE}: Index %{BODY_TAG} %{BANNER} %{HR}

%{TITLE}: Index (%{SEQ})

%{CASE|o|Normal Order, |Reverse Order, }Read, Submit, Search, Old%{IF|LINKS|, Links|}%{IF|OWNER_WEBSITE|, Home|}

----------END; chomp $Default_Thread_Header; #------------------------------------------------------------------------------ my $Default_Tag_WithEnd = <<"----------END;"; A, DIV, SPAN, H1, H2, H3, H4, H5, H6, ADDRESS, EM, STRONG, DFN, CODE, SAMP, KBD, VAR, CITE, ABBR, ACRONYM, BLOCKQUOTE, Q, SUB, SUP, P, PRE, INS, DEL, UL, OL, LI, DL, DT, DD, TT, I, B, BIG, SMALL, STRIKE, S, U, FONT, #TABLE, CAPTION, THEAD, TFOOT, TBODY, COLGROUP, TR, TH, TD, #FORM, BUTTON, SELECT, OPTGROUP, OPTION, TEXTAREA, LABEL, FIELDSET, LEGEND, BLINK, CENTER, ----------END; chomp $Default_Tag_WithEnd; my $Default_Tag_NoEnd = <<"----------END;"; P, BR, LI, DT, DD, HR, #THEAD, TFOOT, TBODY, COL, TR, TH, TD, #IMG, MAP, #INPUT, OPTION, ----------END; chomp $Default_Tag_NoEnd; my $Default_Forbidden_Patterns = <<'----------END;'; # <... OnMouse...=...>, <... OnKey...=...>, etc <[^>]*\son\w*\s*=[^>]*> ----------END; #------------------------------------------------------------------------------ my @Default_Board_Config = ( { 'name' => 'userid', 'value' => "nobody" }, { 'name' => 'passwd', 'value' => "" }, { 'name' => 'title', 'value' => "BBS" }, { 'name' => 'owner_name', 'value' => "" }, { 'name' => 'owner_email', 'value' => "" }, { 'name' => 'owner_website', 'value' => "" }, { 'name' => 'links', 'value' => "Links.html" }, { 'name' => 'status', 'value' => "on" }, { 'name' => 'maxsize', 'value' => 100 * 1024 }, { 'name' => 'suffix', 'value' => $Default_Board_Suffix }, { 'name' => 'body_tag', 'value' => $Default_Body_Tag }, { 'name' => 'hr', 'value' => $Default_Rule }, { 'name' => 'footer', 'value' => $Default_Footer }, { 'name' => 'board_header', 'value' => $Default_Board_Header }, { 'name' => 'board_footer', 'value' => $Default_Board_Footer }, { 'name' => 'article_format', 'value' => $Default_Article_Format }, { 'name' => 'submission_form', 'value' => $Default_Submission_Form }, { 'name' => 'submission_completed', 'value' => $Default_Submission_Completed }, { 'name' => 'search_header', 'value' => $Default_Search_Header }, { 'name' => 'old_logs_header', 'value' => $Default_Old_Logs_Header }, { 'name' => 'thread_header', 'value' => $Default_Thread_Header }, { 'name' => 'index_header', 'value' => $Default_Index_Header }, { 'name' => 'html_tag_restriction', 'value' => "restrict" }, { 'name' => 'html_tag_withend', 'value' => $Default_Tag_WithEnd }, { 'name' => 'html_tag_noend', 'value' => $Default_Tag_NoEnd }, { 'name' => 'html_forbidden_patterns', 'value' => $Default_Forbidden_Patterns }, { 'name' => 'access_restriction', 'value' => "submit" }, { 'name' => 'access_conf', 'value' => "" }, { 'name' => 'access_passwd', 'value' => "" }, { 'name' => 'access_group', 'value' => "" }, ); #============================================================================== # Default Admin Configuration #------------------------------------------------------------------------------ my $Default_Access_Conf = <<"----------END;"; Satisfy any allow from * ----------END; #------------------------------------------------------------------------------ my $Default_Menu = <<"----------END;"; Default Menu of Bulletin Board System $Banner $Default_Rule

Default Menu of Bulletin Board System

$Default_Rule

$inputform_passwd Board-ID:
Board Filename:






$Default_Admin_Footer ----------END; #------------------------------------------------------------------------------ my @Default_Admin_Config = ( { 'name' => 'userid', 'value' => "nobody" }, { 'name' => 'passwd', 'value' => "" }, { 'name' => 'name', 'value' => "" }, { 'name' => 'email', 'value' => "" }, { 'name' => 'website', 'value' => "" }, { 'name' => 'default_menu', 'value' => $Default_Menu }, { 'name' => 'access_restriction', 'value' => "submit" }, { 'name' => 'access_conf', 'value' => $Default_Access_Conf }, { 'name' => 'access_passwd', 'value' => "" }, { 'name' => 'access_group', 'value' => "" }, ); #============================================================================== # Administration my $admin_dir = $BBS_Config_Dir; my $admin_perm = $Perm_Admin; my $admin_filename = "Admin.cgi"; my $admin_file = $admin_dir . "/" . $admin_filename; my $admin = CGI_Board->new; if (-s $admin_file) { open ADMIN, $admin_file or print_and_die("$admin_file: $!"); $admin->read_htmldata(\*ADMIN); close ADMIN; } my $admin_value = $admin->last_value_index; my %admin_value = %$admin_value if defined $admin_value; my $admin_userid = $admin_value{'userid'}; my $admin_passwd = $admin_value{'passwd'}; if ($admin_passwd =~ m!^[^\w/.\$](.*)$!) { $admin_passwd = crypt($1, randsalt()); } foreach (@Default_Admin_Config) { if ($_->{'name'} eq 'userid' || $_->{'name'} eq 'passwd') { next } if (! exists $admin_value{$_->{'name'}} || $admin_value{$_->{'name'}} =~ /^!/) { $admin_value{$_->{'name'}} = $_->{'value'} } } #============================================================================== # Board my $board_id = $cgi_value{'board_id'}; $board_id = $cgi_value{'bid'} if $board_id eq ""; $board_id = $cgi_value{'b'} if $board_id eq ""; my $board_suicide_passwd = "The end of my life with board $board_id"; my $config_suffix = "-config.cgi"; my $config_dir = $BBS_Config_Dir; my $config_perm = $Perm_Config; my $config_filename = $board_id . $config_suffix; my $config_file = $config_dir . "/" . $config_filename; my $config = CGI_Board->new; if (-s $config_file) { open CONFIG, $config_file or print_and_die("$config_file: $!"); $config->read_htmldata(\*CONFIG); close CONFIG; } my $config_value = $config->last_value_index; my %config_value = %$config_value if defined $config_value; my $board_userid = $config_value{'userid'}; my $board_passwd = $config_value{'passwd'}; if ($board_passwd =~ m!^[^\w/.\$](.*)$!) { $board_passwd = crypt($1, randsalt()); } foreach (@Default_Board_Config) { if ($_->{'name'} eq 'userid' || $_->{'name'} eq 'passwd') { next } if (! exists $config_value{$_->{'name'}} || $config_value{$_->{'name'}} =~ /^!/) { $config_value{$_->{'name'}} = $_->{'value'} } } my $board_dir = $BBS_Board_Dir; my $board_dir_url = $BBS_Board_Dir_URL; my $board_suffix = $config_value{'suffix'}; my $board_perm = $Perm_Board; my $board_maxsize = $config_value{'maxsize'}; my $board_seqlen = 4; my $board = CGI_Board->new; $board->board_dir($board_dir); $board->board_id($board_id); $board->board_suffix($board_suffix); $board->board_perm($board_perm); $board->board_maxsize($board_maxsize); $board->board_seqlen($board_seqlen); $board->set_board_new(\&board_new); $board->html_bdrhead("\n"); my $boardlog_dir = $board_dir; my $boardlog_id = $board_id; my $boardlog_suffix = "-log.cgi"; my $boardlog_perm = $Perm_Boardlog; my $boardlog_maxsize = $board_maxsize * 64; my $boardlog_seqlen = $board_seqlen; my $boardlog = CGI_Board->new; $boardlog->board_dir($boardlog_dir); $boardlog->board_id($boardlog_id); $boardlog->board_suffix($boardlog_suffix); $boardlog->board_perm($boardlog_perm); $boardlog->board_maxsize($boardlog_maxsize); $boardlog->board_seqlen($boardlog_seqlen); $boardlog->html_bdrfoot("-->
\n"); # Searchlog file my $searchlog_dir = $board_dir; my $searchlog_filename = $board_id . "-searchlog.cgi"; my $searchlog_file = $board_dir . "/" . $searchlog_filename; my $searchlog_perm = $Perm_Searchlog; my $searchlog_maxsize = 100 * 1024; # To stop logging searchlog, let $searchlog_file be undef. #my $searchlog_file = undef; # Accesslog file my $accesslog_file = $board_dir . "/" . $board_id . "-accesslog.cgi"; #------------------------------------------------------------------------------ my $Board_Menu = <<"----------END;";

Read (via cgi), Submit, Search, Thread, Old

----------END; chomp $Board_Menu; my $Board_Inputform_Passwd = <<"----------END;";

$inputform_passwd Board-ID:

----------END; chomp $Board_Inputform_Passwd; #============================================================================== # Access Control Data my $access_restriction = $admin_value{'access_restriction'} . "," . $config_value{'access_restriction'}; my $access_conf = $admin_value{'access_conf'} . "\n" . $config_value{'access_conf'}; my $passwd_table = $admin_value{'access_passwd'} . "\n" . $config_value{'access_passwd'}; my $group_table = $admin_value{'access_group'} . "\n" . $config_value{'access_group'}; #============================================================================== # Reference to macro hash data my $macro; #============================================================================== #****************************************************************************** # Main Routine #****************************************************************************** ########## For Administrator # Dump Admin Config if (exists $cgi_value{'admin_config_dump'}) { admin_dump($admin_file); exit; } # Dump Syslog if (exists $cgi_value{'admin_syslog_dump'}) { admin_dump($syslog_file); exit; } # Delete Syslog if (exists $cgi_value{'admin_syslog_delete'}) { admin_delete($syslog_file); exit; } # Dump Errorlog if (exists $cgi_value{'admin_errorlog_dump'}) { admin_dump($errorlog_file); exit; } # Delete Errorlog if (exists $cgi_value{'admin_errorlog_delete'}) { admin_delete($errorlog_file); exit; } # Dump Rental_log if (exists $cgi_value{'admin_rentallog_dump'}) { admin_dump($rentallog_file); exit; } # Delete Rental_log if (exists $cgi_value{'admin_rentallog_delete'}) { admin_delete($rentallog_file); exit; } # Add New Board if (exists $cgi_value{'admin_add_new_board'}) { admin_add_new_board(); exit; } # Change Admin Configuration if (exists $cgi_value{'admin_config_change'}) { admin_config_change(); exit; } # Change Admin Password if (defined $cgi_value{'admin_password_change'}) { admin_password_change(); exit; } # Admin Form if (exists $cgi_value{'admin_form'} || exists $cgi_value{'admin'} || exists $cgi_value{'adm'} || exists $cgi_value{'a'} || ! -f $admin_file || -z $admin_file) { admin_form(); exit; } ########## Check board-id # A correct board-id is required in the following. if ($board_id eq "") { default_menu(); exit; } elsif ($board_id =~ /[^a-z_]/) { print_and_die("$board_id: invalid character in board-id"); } elsif (! -r $config_file) { print_and_die(qq!Board "$board_id" is not found!); } ########## For Board Owners # Change Board Configuration if (exists $cgi_value{'board_config_change'}) { board_config_change(); exit; } # Dump Board Configuration File if (exists $cgi_value{'board_config_dump'}) { board_owner_dump($config_file); exit; } # Dump Board Searchlog if (exists $cgi_value{'board_searchlog_dump'}) { board_owner_dump($searchlog_file); exit; } # Dump Board Accesslog if (exists $cgi_value{'board_accesslog_dump'}) { board_owner_dump($accesslog_file); exit; } # Delete Board Searchlog if (exists $cgi_value{'board_searchlog_delete'}) { board_owner_delete($searchlog_file); exit; } # Delete Board Accesslog if (exists $cgi_value{'board_accesslog_delete'}) { board_owner_delete($accesslog_file); exit; } # Delete Board Oldlogs if (exists $cgi_value{'board_oldlogs_delete'}) { board_oldlogs_delete(); exit; } # Board Suicide if (exists $cgi_value{'board_suicide'}) { board_suicide(); exit; } # Update Current Board Style if (exists $cgi_value{'update_current_board_style'}) { update_current_board_style(); print_content_type(); print $cgi->extcode(<<"----------END;"); Current Board Style of "$board_id" Updated $Banner $Default_Rule

Current Board Style of "$board_id" Updated

$Board_Menu $Default_Rule $Board_Inputform_Passwd $Default_Admin_Footer ----------END; exit; } # New Board File if (exists $cgi_value{'new_board_file'}) { new_board_file(); print_content_type(); print $cgi->extcode(<<"----------END;"); New Board File of "$board_id" Created $Banner $Default_Rule

New Board File of "$board_id" Created

$Board_Menu $Default_Admin_Footer ----------END; exit; } # Reset Board Configuration to Default if (exists $cgi_value{'reset_board_style_default'}) { reset_board_style_default(); exit; } # Change Board Password if (exists $cgi_value{'board_passwd_change'}) { board_passwd_change(); exit; } # Board Config Form if (exists $cgi_value{'board_config_form'} || exists $cgi_value{'config'} || exists $cgi_value{'conf'} || exists $cgi_value{'c'}) { board_config_form(); exit; } ########## Board Editing # Replace Articles if (exists $cgi_value{'board_article_replace'}) { board_article_replace(); exit; } # Edit Articles if (exists $cgi_value{'board_article_edit'}) { board_article_edit(); exit; } # Delete Articles if (exists $cgi_value{'board_article_delete'}) { board_article_delete(); exit; } # Board Editing Form if (exists $cgi_value{'board_edit_form'}) { board_edit_form(); exit; } ########## Search if (exists $cgi_value{'board_search'} || exists $cgi_value{'search'}) { board_search(); exit; } ########## Old Logs if (exists $cgi_value{'board_old_logs'} || exists $cgi_value{'old_logs'} || exists $cgi_value{'old'}) { board_old_logs(); exit; } ########## Threaded Index if (exists $cgi_value{'board_thread'} || exists $cgi_value{'thread'}) { board_thread(); exit; } ########## Index if (exists $cgi_value{'board_index'} || exists $cgi_value{'index'}) { board_index(); exit; } ########## Set %article_format my %article_format = map { /^[\#\s]*(.*?)\s*\n((?:.|\n)*)$/ } split /\n\#/, $config_value{'article_format'}; ########## Submission of Articles # Submit Article foreach (keys %article_format) { if ($cgi_value{'submit_' . $_} ne "") { submit_article('submit_' . $_); exit; } } # Preview and Submission foreach (keys %article_format) { if ($cgi_value{'preview_' . $_} ne "") { submission_form('preview_' . $_); exit; } } # Submission Form if (exists $cgi_value{'submission'} || exists $cgi_value{'submit'} || exists $cgi_value{'post'}) { submission_form('submission'); exit; } # Read Board read_board(); exit; #****************************************************************************** # End of Main Routine #****************************************************************************** #============================================================================== # Default Menu sub default_menu { print_content_type(); print $cgi->extcode($admin_value{'default_menu'}); return 1; } #============================================================================== # For Administrator #------------------------------------------------------------------------------ sub admin_password_change { my $cgi_new_userid = $cgi_value{'new_userid'}; my $cgi_new_passwd = $cgi_value{'new_passwd'}; my $cgi_new_passwd2 = $cgi_value{'new_passwd2'}; my $crypted_new_passwd = crypt($cgi_new_passwd, randsalt()); check_bbslock("Can't change admin password"); if ($cgi_new_passwd ne $cgi_new_passwd2) { print_and_die("Retyped password mismatched"); } elsif ($cgi_new_userid eq "") { print_and_die("Empty new user-id"); } elsif ($cgi_new_passwd eq "") { print_and_die("Empty new password"); } elsif ($cgi_new_passwd =~ /[\200-\377]/) { print_and_die("Invalid character in new password"); } print_syslog("admin_password_change"); my $completed; if (! -f $admin_file || -z $admin_file) { $completed = "Administrator Registration completed"; } elsif (match_cgi_password($admin_userid, $admin_passwd)) { $completed = "Change of Admin Password completed"; } else { print_and_die("Invalid user-id or wrong password"); } $admin->set_content( $admin->grep(q! $_->{'name'} ne 'userid' && $_->{'name'} ne 'passwd' !) ); $admin->unshift( { 'name' => 'userid', 'value' => $cgi_new_userid }, { 'name' => 'passwd', 'value' => $crypted_new_passwd }, ); open ADMIN, ">$admin_file" or print_and_die("$admin_file: $!"); $admin->print_htmldata(\*ADMIN); close ADMIN; chmod $admin_perm, $admin_file; print_content_type(); print $cgi->extcode(<<"----------END;"); $completed $Banner $Default_Rule

$completed

$Default_Rule

Please set up BBS configuration in Administration Form.

$inputform_passwd

$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub admin_dump { my ($file) = @_; unless (match_cgi_password($admin_userid, $admin_passwd)) { print_and_die("Invalid user-id or wrong password"); } open FILE, $file or print_and_die("$file: $!"); print_content_type("text/plain"); while () { print } close FILE; print_syslog("admin_dump: $file"); return 1; } #------------------------------------------------------------------------------ sub admin_delete { my ($file) = @_; check_bbslock("Can't delete admin file"); unless (match_cgi_password($admin_userid, $admin_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); unlink $file; print_content_type(); print $cgi->extcode(<<"----------END;"); File $file Deleted $Banner $Default_Rule

File $file Deleted

$Default_Rule

$inputform_passwd

$Default_Admin_Footer ----------END; print_syslog("admin_delete: $file"); return 1; } #------------------------------------------------------------------------------ sub admin_config_change { check_bbslock("Can't change admin config"); unless (match_cgi_password($admin_userid, $admin_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("admin_config_change"); my @item; foreach (0..$#Default_Admin_Config) { $item[$_] = $Default_Admin_Config[$_]{'name'}; } @item = grep !(/^userid$/ || /^passwd$/), @item; my @fixed = qw( userid passwd ); my $tmp; foreach (split /\n/, $cgi_value{'admin_access_passwd'}) { if (m!^\s*([^\s\#]+)\s*:\s*[^\w./\#\$]([^\s\#]*)(.*)$!) { $tmp .= $1 . ":" . crypt($2, randsalt()) . $3 . "\n"; } else { $tmp .= $_ . "\n"; } } chomp $tmp; $cgi_value{'admin_access_passwd'} = $tmp; foreach (@item) { $admin_value{$_} = $cgi_value{'admin_' . $_}; } my $admin = CGI_Board->new; unshift @item, @fixed; foreach (0..$#item) { $admin->content($_, 'name', $item[$_]); $admin->content($_, 'value', $admin_value{$item[$_]}); } open ADMIN, ">$admin_file" or print_and_die("$admin_file: $!"); $admin->print_htmldata(\*ADMIN); close ADMIN; chmod $admin_perm, $admin_file; print_content_type(); print $cgi->extcode(<<"----------END;"); Change of Admin Configuration completed $Banner $Default_Rule

Change of Admin Configuration completed

$Default_Rule

$inputform_passwd

$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub admin_add_new_board { check_bbslock("Can't create new board"); unless (match_cgi_password($admin_userid, $admin_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); my $cgi_new_board_userid = $cgi_value{'new_board_userid'}; my $cgi_new_board_passwd = $cgi_value{'new_board_passwd'}; my $cgi_new_board_passwd2 = $cgi_value{'new_board_passwd2'}; my $cgi_new_board_id = $cgi_value{'new_board_id'}; my $crypted_new_passwd = crypt($cgi_new_board_passwd, randsalt()); if ($cgi_new_board_id eq "") { print_and_die("Empty new board-id"); } elsif ($cgi_new_board_id =~ /[^a-z_]/) { print_and_die("$cgi_new_board_id: invalid character in new board-id"); } elsif (-f $config_dir . "/" . $cgi_new_board_id . $config_suffix) { print_and_die("$cgi_new_board_id: new board-id already used"); } elsif ($cgi_new_board_passwd ne $cgi_new_board_passwd2) { print_and_die("Retyped password mismatched"); } elsif ($cgi_new_board_userid eq "") { print_and_die("Empty new user-id"); } elsif ($cgi_new_board_passwd eq "") { print_and_die("Empty new password"); } elsif ($cgi_new_board_passwd =~ /[\200-\377]/) { print_and_die("Invalid character in new password"); } print_syslog("admin_add_new_board: $cgi_new_board_id"); my $config = CGI_Board->new; $config->set_content( grep $_->{'name'} ne 'userid' && $_->{'name'} ne 'passwd', @Default_Board_Config ); $config->unshift( { 'name' => 'userid', 'value' => $cgi_new_board_userid }, { 'name' => 'passwd', 'value' => $crypted_new_passwd }, ); $config_filename = $cgi_new_board_id . $config_suffix; $config_file = $config_dir . "/" . $config_filename; open CONFIG, ">$config_file" or print_and_die("$config_file: $!"); $config->print_htmldata(\*CONFIG); close CONFIG; chmod $config_perm, $config_file; print_content_type(); print $cgi->extcode(<<"----------END;"); New Board "$cgi_new_board_id" Added $Banner $Default_Rule

New Board "$cgi_new_board_id" Added

Submit

$Default_Rule

Please set up new board configuration.

$inputform_passwd Board-ID:

$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub admin_form { unless (defined $admin_userid && defined $admin_passwd) { print_syslog("Administrator Registration"); my $inputform_new_passwd = inputform_passwd("", "new_", "retype"); print_content_type(); print $cgi->extcode(<<"----------END;"); Administrator Registration $Banner $Default_Rule

Administrator Registration

$Default_Rule

$inputform_new_passwd

$Default_Admin_Footer ----------END; return 1; } unless (match_cgi_password($admin_userid, $admin_passwd)) { print_errorlog("admin_form: invalid user-id or wrong password"); print_content_type(); print $cgi->extcode(<<"----------END;"); User-ID and Password $Banner $Default_Rule

User-ID and Password

$Default_Rule

Please input user-id and password.

$inputform_passwd

$Default_Admin_Footer ----------END; return undef; } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("admin_form"); print_content_type(); # header print $cgi->extcode(<<"----------END;"); Administration Form $Banner $Default_Rule

Administration Form

$Default_Rule

Table of Contents

----------END; my ($size, $mtime); # board config form print $cgi->extcode(<<"----------END;"); $Default_Rule

Board Configuration Form

----------END; opendir CONFIGDIR, $config_dir or print_and_die("$config_dir: $!"); my @config_files = grep /^(.*)\Q$config_suffix\E$/, readdir CONFIGDIR; close CONFIGDIR; if (@config_files) { print $cgi->extcode(<<"----------END;");
----------END;
    foreach (@config_files) {
      ($size, $mtime) = (stat $config_dir . "/" . $_)[7,9];
      printf "%8d %s %s\n", $size, localdate('S', $mtime), "$config_dir/$_";
    }
    print $cgi->extcode(<<"----------END;");
----------END; } print $cgi->extcode(<<"----------END;");
$inputform_passwd Board-ID:
----------END; # add new board my $inputform_board_passwd = inputform_passwd("New Board ", "new_board_", "retype"); print $cgi->extcode(<<"----------END;"); $Default_Rule

Add New Board

$inputform_passwd
$inputform_board_passwd
New Board-ID: (allowed chars: [a-z_]; e.g. bbs_a, keijiban_b)
----------END; # system files print $cgi->extcode(<<"----------END;"); $Default_Rule

System Files

----------END;
  ($size, $mtime) = (stat $admin_file)[7,9];
  printf "%8d %s %s\n", $size, localdate('S', $mtime), $admin_file;
  if (-f $syslog_file) {
    ($size, $mtime) = (stat $syslog_file)[7,9];
    printf "%8d %s %s\n", $size, localdate('S', $mtime), $syslog_file;
  }
  if (-f $errorlog_file) {
    ($size, $mtime) = (stat $errorlog_file)[7,9];
    printf "%8d %s %s\n", $size, localdate('S', $mtime), $errorlog_file;
  }
  if (-f $rentallog_file) {
    ($size, $mtime) = (stat $rentallog_file)[7,9];
    printf "%8d %s %s\n", $size, localdate('S', $mtime), $rentallog_file;
  }
  print $cgi->extcode(<<"----------END;");
$inputform_passwd



----------END; # quote & < > " foreach (keys %admin_value) { if ($_ eq "access_restriction") { $admin_value{$_} = quotequot($admin_value{$_}); } else { $admin_value{$_} = quotehtml($admin_value{$_}); } } # change admin config print $cgi->extcode(<<"----------END;"); $Default_Rule

Change Admin Configuration

$Default_Dash

Administrator's Information

Name:

E-mail Address:

URL of Web Site:

$Default_Dash

Default Menu

$Default_Dash

Access Configuration

Access Restriction (e.g.: submit or submit,read):

Access Configuration Script:

Password Table:

Group Table:

$Default_Dash

$inputform_passwd
Change:

$Default_Dash

----------END; # change user-id and password my $inputform_new_passwd = inputform_passwd("New ", "new_", "retype"); print $cgi->extcode(<<"----------END;"); $Default_Rule

Change User-ID and Password of Admin

$inputform_passwd
$inputform_new_passwd
----------END; # footer print $cgi->extcode(<<"----------END;"); $Default_Admin_Footer ----------END; return 1; } #============================================================================== # For Board Owners #------------------------------------------------------------------------------ sub board_config_change { check_bbslock("Can't change board configuration"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } print_syslog("board_config_change"); my @fixed = qw( userid passwd ); my @item; foreach (0..$#Default_Board_Config) { unless ($Default_Board_Config[$_]{'name'} =~ /^(?:userid|passwd)$/) { push @item, $Default_Board_Config[$_]{'name'}; } } # crypt '!abcdefg' style password if ($cgi_value{'passwd'} =~ m!^[^\w./\$](.*)$!) { $cgi_value{'passwd'} = crypt($1, randsalt()); } my $tmp; foreach (split /\n/, $cgi_value{'board_access_passwd'}) { if (m!^\s*([^\s\#]+)\s*:\s*[^\w./\#\$]([^\s\#]*)(.*)$!) { $tmp .= $1 . ":" . crypt($2, randsalt()) . $3 . "\n"; } else { $tmp .= $_ . "\n"; } } chomp $tmp; $cgi_value{'board_access_passwd'} = $tmp; foreach (@item) { $config_value{$_} = $cgi_value{'board_' . $_}; # Forbid SSI in board config files for safety # $config_value{$_} =~ s,<\!--\#[^>]*>,,g; $config_value{$_} =~ s,<\!--\#(?!exec c..="\./(?:LOGREC"|logwrite|/ad/ads\.pl"))[^>]*>,,g; } $config->splice(0); # clear $config->content unshift @item, @fixed; foreach (0..$#item) { $config->push({ 'name' => $item[$_], 'value' => $config_value{$item[$_]} }); } open CONFIG, ">$config_file" or print_and_die("$config_file: $!"); $config->print_htmldata(\*CONFIG); close CONFIG; chmod $config_perm, $config_file; my $link = $board_dir . "/" . $board_id . $board_suffix; if (-l $link && $config_value{'suffix'} ne $board_suffix) { my $linknew = $board_dir . "/" . $board_id . $config_value{'suffix'}; if (-f $linknew) { print_and_die("$linknew already exists ", "and stopped renaming $link $linknew"); } filelock($link) or print_and_die("$link: locked"); rename $link, $linknew or fileunlock($link), print_and_die("($link, $linknew): $!"); fileunlock($link); } $config_value = $config->last_value_index; %config_value = %$config_value if defined $config_value; $board_suffix = $config_value{'suffix'}; $board->board_suffix($board_suffix); update_current_board_style(); print_content_type(); print $cgi->extcode(<<"----------END;"); Configuration of Board "$board_id" Changed $Banner $Default_Rule

Configuration of Board "$board_id" Changed

$Board_Menu $Default_Rule $Board_Inputform_Passwd $Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub update_board_style { check_bbslock("Can't update board style"); my ($update_filename, $previous_filename) = @_; unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } my $link = $board_dir . "/" . $board_id . $board_suffix; filelock($link) or print_and_die("$link: locked"); $board->splice(0); # clear $board->content $boardlog->splice(0); # clear $boardlog->content my $update_file = $board_dir . "/" . $update_filename; if (-f $update_file) { open FILE, $update_file or fileunlock($link), print_and_die("$update_file: $!"); $board->read_htmldata(\*FILE); close FILE; } $macro = board_macro('board', 'new', $update_filename, $previous_filename); $board->board_new; open FILE, ">$update_file" or fileunlock($link), print_and_die("$update_file: $!"); $board->print_htmldata(\*FILE); close FILE; chmod $Perm_Board, $update_file; fileunlock($link); return 1; } #------------------------------------------------------------------------------ sub update_current_board_style { check_bbslock("Can't update current board style"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } print_syslog("update_current_board_style"); my $link = $board_dir . "/" . $board_id . $board_suffix; my $log_link = $boardlog_dir . "/" . $boardlog_id . $boardlog_suffix; filelock($link) or print_and_die("$link: locked"); if (-e $link && ! -l $link) { fileunlock($link), print_and_die("$link: not symbolic link"); } if (-e $log_link && ! -l $log_link) { fileunlock($link), print_and_die("$log_link: not symbolic link"); } if (-l $link) { unlink $link or fileunlock($link), print_and_die("$link: $!"); } if (-l $log_link) { unlink $log_link or fileunlock($link), print_and_die("$log_link: $!"); } my ($stat, $current, $previous) = $board->board_check_current(); my ($seq) = ( $current =~ /^$board_id([0-9]*)/ ); my ($oldseq) = ( $previous =~ /^$board_id([0-9]*)/ ); my $filename = $board_id . $seq . $board_suffix; symlink $filename, $link or fileunlock($link), print_and_die("$filename: $!"); my $bin = $board_dir . "/" . $board_id . ".bin"; if (-l $bin) { unlink $bin or fileunlock($link), print_and_die("$bin: $!"); } symlink $board_id . $board_suffix, $bin or fileunlock($link), print_and_die("$bin: $!"); my $log_filename = $boardlog_id . $seq . $boardlog_suffix; my $oldlog_filename = $boardlog_id . $oldseq . $boardlog_suffix if $oldseq ne ""; if (! -f "$boardlog_dir/$log_filename") { open LOG, ">$boardlog_dir/$log_filename" or fileunlock($link), print_and_die("$boardlog_dir/$log_filename: $!"); $boardlog->board_new($log_filename, $oldlog_filename); $boardlog->print_htmldata(\*LOG); close LOG; } symlink $log_filename, $log_link or fileunlock($link), print_and_die("$log_link: $!"); fileunlock($link); update_board_style($current, $previous); return 1; } #------------------------------------------------------------------------------ sub new_board_file { check_bbslock("Can't new board file"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } print_syslog("new_board_file"); my $link = $board_dir . "/" . $board_id . $board_suffix; filelock($link) or print_and_die("$link: locked"); if (-e $link && ! -l $link) { fileunlock($link), print_and_die("$link: not symbolic link"); } if (-l $link) { unlink $link or fileunlock($link), print_and_die("$link: $!"); } my ($stat, $current, $previous) = $board->board_check_current(); my ($seq) = ( $current =~ /^$board_id([0-9]*)/ ); my $next_seq = sprintf("%0${board_seqlen}d", $seq + 1); my $filename = $board_id . $next_seq . $board_suffix; my $file = $board_dir . "/" . $filename; open FILE, ">>$file" or fileunlock($link), print_and_die("$file"); print FILE ""; close FILE; fileunlock($link); update_current_board_style(); return 1; } #------------------------------------------------------------------------------ sub board_owner_dump { my ($file) = @_; unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } print_syslog("board_owner_dump: $file"); open FILE, $file or print_and_die("$file: $!"); print_content_type("text/plain"); while () { print } close FILE; return 1; } #------------------------------------------------------------------------------ sub board_owner_delete { my @files = @_; check_bbslock("Can't delete board owner's file"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } my $files = join(",", @files); print_syslog("board_owner_delete: $files"); for (@files) { unlink $_ } $files = join("\n", @files); print_content_type(); print $cgi->extcode(<<"----------END;"); Deletion completed $Banner $Default_Rule

Deletion completed

$Board_Menu $Default_Rule

List of Deleted Files

$files
$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_oldlogs_delete { check_bbslock("Can't delete board old logs"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } $macro = board_macro('search'); my $current_seq = $macro->{'STAT_NEXT'} ? $macro->{'PREVIOUS_SEQ'} : $macro->{'CURRENT_SEQ'}; my $max_seq = $cgi_value{'board_seq'}; $max_seq = $current_seq - 1 if $max_seq >= $current_seq; opendir DIR, $board_dir or print_and_die("$board_dir: $!"); my @files = map { $board_dir . "/" . $_ } sort grep { /^\Q$board_id\E([0-9]+)(?:\Q$board_suffix\E|\Q$boardlog_suffix\E)$/ && $1 <= $max_seq } readdir DIR; closedir DIR; board_owner_delete(@files); return 1; } #------------------------------------------------------------------------------ sub board_suicide { check_bbslock("Can't suicide"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } unless ($cgi_value{'board_suicide_passwd'} eq $board_suicide_passwd) { print_and_die("Wrong suicide password"); } opendir DIR, $board_dir or print_and_die("$board_dir: $!"); my @files = map { $board_dir . "/" . $_ } sort grep { /^\Q$board_id\E([0-9]*)(?:\Q$board_suffix\E|\Q$boardlog_suffix\E|\.bin)$/ } readdir DIR; closedir DIR; push @files, $accesslog_file if -f $accesslog_file; push @files, $searchlog_file if -f $searchlog_file; my $config_file = $config_dir . "/" . $board_id . $config_suffix; push @files, $config_file; my $item_file = $config_dir . "/" . $board_id . "-item.cgi"; push @files, $item_file; my $files = join(",", @files); print_syslog("board_suicide: $files"); for (@files) { unlink $_ } $files = join("\n", @files); print_content_type(); print $cgi->extcode(<<"----------END;"); Board Suicide completed $Banner $Default_Rule

Board Suicide completed

$Default_Rule

List of Deleted Files

$files
$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub reset_board_style_default { check_bbslock("Can't reset board style default"); unless ( match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd) ) { print_and_die("Invalid user-id or wrong password"); } print_syslog("reset_board_style_default"); my @item; $config->set_content( $config->grep(q! $_->{'name'} eq 'userid' || $_->{'name'} eq 'passwd' || $_->{'name'} eq 'title' || $_->{'name'} eq 'owner_name' || $_->{'name'} eq 'owner_email' || $_->{'name'} eq 'owner_website' || $_->{'name'} eq 'status' || $_->{'name'} eq 'maxsize' || $_->{'name'} eq 'suffix' || $_->{'name'} eq 'access_restriction' || $_->{'name'} eq 'access_conf' || $_->{'name'} eq 'access_passwd' || $_->{'name'} eq 'access_group' !) ); foreach (@Default_Board_Config) { unless ( $_->{'name'} eq 'userid' || $_->{'name'} eq 'passwd' || $_->{'name'} eq 'title' || $_->{'name'} eq 'owner_name' || $_->{'name'} eq 'owner_email' || $_->{'name'} eq 'owner_website' || $_->{'name'} eq 'status' || $_->{'name'} eq 'maxsize' || $_->{'name'} eq 'suffix' || $_->{'name'} eq 'access_restriction' || $_->{'name'} eq 'access_conf' || $_->{'name'} eq 'access_passwd' || $_->{'name'} eq 'access_group' ) { $config->push( { 'name' => $_->{'name'}, 'value' => $_->{'value'} } ); } } open CONFIG, ">$config_file" or print_and_die("$config_file: $!"); $config->print_htmldata(\*CONFIG); close CONFIG; chmod $config_perm, $config_file; $config_value = $config->last_value_index; %config_value = %$config_value if defined $config_value; update_current_board_style(); print_content_type(); print $cgi->extcode(<<"----------END;"); Style of Board "$board_id" Reset to Default $Banner $Default_Rule

Style of Board "$board_id" Reset to Default

$Board_Menu $Default_Rule $Board_Inputform_Passwd $Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_passwd_change { check_bbslock("Can't change board password"); unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $cgi_new_board_userid = $cgi_value{'new_board_userid'}; my $cgi_new_board_passwd = $cgi_value{'new_board_passwd'}; my $cgi_new_board_passwd2 = $cgi_value{'new_board_passwd2'}; my $crypted_new_passwd = crypt($cgi_new_board_passwd, randsalt()); if ($cgi_new_board_passwd ne $cgi_new_board_passwd2) { print_and_die("Retyped password mismatched"); } elsif ($cgi_new_board_userid eq "") { print_and_die("Empty new user-id"); } elsif ($cgi_new_board_passwd eq "") { print_and_die("Empty new password"); } elsif ($cgi_new_board_passwd =~ /[\200-\377]/) { print_and_die("Invalid character in new password"); } print_syslog("board_passwd_change"); $config->set_content( $config->grep(q! $_->{'name'} ne 'userid' && $_->{'name'} ne 'passwd' !) ); $config->unshift( { 'name' => 'userid', 'value' => $cgi_new_board_userid }, { 'name' => 'passwd', 'value' => $crypted_new_passwd }, ); open CONFIG, ">$config_file" or print_and_die("$config_file: $!"); $config->print_htmldata(\*CONFIG); close CONFIG; chmod $config_perm, $config_file; print_content_type(); print $cgi->extcode(<<"----------END;"); Password of Board "$board_id" Changed $Banner $Default_Rule

Password of Board "$board_id" Changed

$Board_Menu $Default_Rule $Board_Inputform_Passwd $Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_config_form { unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_errorlog("board_config_form: invalid user-id or wrong password"); print_content_type(); print $cgi->extcode(<<"----------END;"); User-ID and Password $Banner $Default_Rule

User-ID and Password

$Default_Rule

Please input user-id and password.

$inputform_passwd Board-ID:

$Default_Admin_Footer ----------END; return undef; } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("board_config_form"); # quote & < > " foreach (keys %config_value) { if ( /^title$/ || /^owner_name$/ || /^owner_email$/ || /^owner_website$/ || /^links$/ || /^body_tag$/ || /^hr$/ || /^footer$/ || /^board_header$/ || /^board_footer$/ || /^article_format$/ || /^submission_form$/ || /^submission_completed$/ || /^search_header$/ || /^old_logs_header$/ || /^thread_header$/ || /^index_header$/ || /^html_tag_withend$/ || /^html_tag_noend$/ || /^html_forbidden_patterns$/ || /^access_conf$/ || /^access_passwd$/ || /^access_group$/ ) { $config_value{$_} = quotehtml($config_value{$_}); } else { $config_value{$_} = quotequot($config_value{$_}); } } print_content_type(); # header print $cgi->extcode(<<"----------END;"); Configration Form of Board "$board_id" $Banner $Default_Rule

Configration Form of Board "$board_id"

$Board_Menu $Default_Rule

Table of Contents

----------END; # system files print $cgi->extcode(<<"----------END;"); $Default_Rule

System Files

----------END;
  my ($size, $mtime);
  ($size, $mtime) = (stat $config_file)[7,9];
  printf "%8d %s %s\n", $size, localdate('S', $mtime), $config_file;
  if (-f $searchlog_file) {
    ($size, $mtime) = (stat $searchlog_file)[7,9];
    printf "%8d %s %s\n", $size, localdate('S', $mtime), $searchlog_file;
  }
  if (-f $accesslog_file) {
    ($size, $mtime) = (stat $accesslog_file)[7,9];
    printf "%8d %s %s\n", $size, localdate('S', $mtime), $accesslog_file;
  }
  print $cgi->extcode(<<"----------END;");
$inputform_passwd


----------END; # edit board file my $rndseq = sprintf("%0${board_seqlen}d", int(rand(100))); print $cgi->extcode(<<"----------END;"); $Default_Rule

Edit Board File

$inputform_passwd
Board Filename: (e.g.: $board_id$rndseq$board_suffix)
----------END; # delete old logs my $startseq = sprintf("%0${board_seqlen}d", 0); print $cgi->extcode(<<"----------END;"); $Default_Rule

Delete Old Logs

$inputform_passwd
Board File Number: (e.g.: Input $rndseq to delete $board_id$startseq-$board_id$rndseq)
----------END; # change board config print $cgi->extcode(<<"----------END;"); $Default_Rule

Change Board Configuration

$Default_Dash

Title and Owner's Information

Title (%{TITLE}):

Owner's Name (%{OWNER_NAME}):

E-mail Address (%{OWNER_EMAIL}):

URL of Web Site (%{OWNER_WEBSITE}):

Links (%{LINKS}):

$Default_Dash

System Configuration

Board Status (on or off):
Board Max Size:
Board Suffix (e.g.: .html):

$Default_Dash

Tags and Footer

Body Tag (%{BODY_TAG}):

Horizontal Rule (%{HR}):

Footer (%{FOOTER}):

$Default_Dash

Board Style

Board Header:

Board Footer:

$Default_Dash

Article Styles

$Default_Dash

Submission Style

Submission Form:

Submission Completed Message:

$Default_Dash

Index Header

$Default_Dash

Threaded Index Header

$Default_Dash

Search Header

$Default_Dash

Old Logs Header

$Default_Dash

HTML Tag Restriction

Restrition (restrict or not):

List of Permitted Tags which require end tags:

List of Permitted Tags which allow to omit end tags:

List of Forbidden Patterns:

$Default_Dash

Access Configuration

Access Restriction (e.g: submit or submit,read):

Access Configuration:

Password Table:

Group Table:

$Default_Dash

$inputform_passwd
Change:

$Default_Dash

----------END; # update current board style print $cgi->extcode(<<"----------END;"); $Default_Rule

Update Current Board Style

$inputform_passwd
----------END; # new board file print $cgi->extcode(<<"----------END;"); $Default_Rule

New Board File

$inputform_passwd
----------END; # reset board style to default print $cgi->extcode(<<"----------END;"); $Default_Rule

Reset Board Style to Default

$inputform_passwd
----------END; # change user-id and password my $inputform_new_passwd = inputform_passwd("New ", "new_board_", "retype"); print $cgi->extcode(<<"----------END;"); $Default_Rule

Change User-ID and Password of Board

$inputform_passwd
$inputform_new_passwd
----------END; # delete board file print $cgi->extcode(<<"----------END;"); $Default_Rule

Suicide

$inputform_passwd

Please input "$board_suicide_passwd":


----------END; # footer print $cgi->extcode(<<"----------END;"); $Default_Admin_Footer ----------END; return 1; } #============================================================================== # Replace and Delete Articles #------------------------------------------------------------------------------ sub board_article_replace { check_bbslock("Can't replace article"); unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("board_article_replace"); my $filename = $cgi_value{'board_filename'}; my $link = $board_dir . "/" . $board_id . $board_suffix; my $file = $board_dir . "/" . $filename; my ($seq, $suffix) = ( $filename =~ /^\Q$board_id\E([0-9]{$board_seqlen})(.*)$/ ); my $log_filename = $board_id . $seq . $boardlog_suffix; my $log_file = $boardlog_dir . "/" . $log_filename; $board->splice(0); # clear $board->content $boardlog->splice(0); # clear $boardlog->content my @id_list = map { /^checked_($board_id.*)$/ } keys %cgi_value; my @field_list; foreach (@id_list) { if (exists $cgi_value{'content_' . $_}) { push @field_list, { 'name' => $_, 'value' => $cgi_value{'content_' . $_} }; } } my ($status, @replaced) = $board->board_replace($filename, @field_list); filelock($link) or print_and_die("$link: locked"); open LOG, $log_file or fileunlock($link), print_and_die("$log_file: $!"); $boardlog->read_htmldata(\*LOG); close LOG; my ($id, $n, $value); my $datem = localdate('M'); my ($name, $subject, $replyto); foreach $id (@id_list) { foreach $n (0..$#{$boardlog->content}) { if ($boardlog->content($n, 'name') eq $id) { $value = $boardlog->content($n, 'value'); $name = quotecomm($cgi_value{'name_' . $id}); $subject = quotecomm($cgi_value{'subject_' . $id}); $replyto = quotecomm($cgi_value{'replyto_' . $id}); $value =~ s/^((?:.|\n)*?),(?:.|\n)*?,(?:.|\n)*?,(?:.|\n)*?,(?:.|\n)*?,((?:.|\n)*)$/$1,replaced$datem,$name,$subject,$replyto,$2/; $boardlog->content($n, 'value', $value); last; } } } open LOG, ">$log_file" or fileunlock($link), print_and_die("$log_file: $!"); $boardlog->print_htmldata(\*LOG); close LOG; fileunlock($link); my (@next, $next); $next[0] = sprintf("%s%0${board_seqlen}d%s", $board_id, $seq + 1, $suffix); $next[1] = sprintf("%s%0${board_seqlen}d%s", $board_id, $seq + 1, $board_suffix); foreach (@next) { if (-f $board_dir . "/" . $_) { $next = $_; last; } } if (defined $next) { update_board_style($next, $filename); } print_content_type(); # header print $cgi->extcode(<<"----------END;"); Checked Articles in $filename Replaced $Banner $Default_Rule

Checked Articles in $filename Replaced

Read $filename (via cgi), Read Current Board (via cgi)

----------END; # list of replaced articles if (@replaced) { print $cgi->extcode(<<"----------END;"); $Default_Rule

List of Replaced Articles

----------END; foreach (@replaced) { print $cgi->extcode($_->{'value'}); } } else { print $cgi->extcode(<<"----------END;"); $Default_Rule

No Article Replaced

----------END; } # footer print $cgi->extcode(<<"----------END;"); $Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_article_edit { check_bbslock("Can't edit article"); unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("board_article_edit"); my $filename = $cgi_value{'board_filename'}; my $link = $board_dir . "/" . $board_id . $board_suffix; my $file = $board_dir . "/" . $filename; my ($seq, $suffix) = ( $filename =~ /^\Q$board_id\E([0-9]+)(.*)$/ ); my $log_filename = $board_id . $seq . $boardlog_suffix; my $log_file = $boardlog_dir . "/" . $log_filename; if (! defined $filename) { print_and_die("board_filename is not defined"); } elsif (! -f $file) { print_and_die("$file: not found"); } elsif (! -f $log_file) { print_and_die("$log_file: not found"); } $board->splice(0); # clear $board->content $boardlog->splice(0); # clear $boardlog->content print_content_type(); # header print $cgi->extcode(<<"----------END;"); Editing Form for Checked Articles in $filename $Banner $Default_Rule

Editing Form for Checked Articles in $filename

Read $filename (via cgi), Read Current Board (via cgi)

$Default_Rule $inputform_passwd ----------END; # List of Checked Articles print $cgi->extcode(<<"----------END;"); $Default_Rule

Checked Articles in $filename

----------END; open LOG, $log_file or print_and_die("$log_file: $!"); $boardlog->read_htmldata(\*LOG); close LOG; my $boardlog_value = $boardlog->last_value_index; my %boardlog_value = %$boardlog_value if defined $boardlog_value; open FILE, $file or print_and_die("$file: $!"); $board->read_htmldata(\*FILE); close FILE; my $board_value = $board->last_value_index; my %board_value = %$board_value if defined $board_value; my @id_list = map { /^checked_($board_id.*)$/ } keys %cgi_value; my ($id, $sid, $article_stat, $name, $subject, $replyto, $date, $passwd); my ($remote_host, $http_user_agent, $http_x_forwarded_for, $http_cookie); my ($rawname, $rawsubject, $rawreplyto); my ($boardlog_line, $misc_info, $content); foreach $id (@id_list) { ($sid, $article_stat, $name, $subject, $replyto, $date, $passwd, $remote_host, $http_user_agent, $http_x_forwarded_for, $http_cookie) = map { unquotecomm($_) } split /,/, $boardlog_value{$id}; $rawname = quotehtml($name); $rawsubject = quotehtml($subject); $rawreplyto = quotehtml($replyto); $name =~ s!<[^>]*>!!g; $subject =~ s!<[^>]*>!!g; $replyto =~ s!<[^>]*>!!g; $date =~ s!<[^>]*>!!g; $name = quotehtml($name); $subject = quotehtml($subject); $subject = $id if $subject =~ /^\s*$/; $replyto = quotehtml($replyto); $remote_host = quotehtml($remote_host); $http_user_agent = quotehtml($http_user_agent); $http_x_forwarded_for = quotehtml($http_x_forwarded_for); $http_cookie = quotehtml($http_cookie); $misc_info = qq!"$remote_host", "$http_user_agent", ! . qq!"$http_x_forwarded_for", "$http_cookie", "$passwd"!; print $cgi->extcode(<<"----------END;");
----------END; if ($article_stat =~ /^del/) { print qq! o $article_stat !; } elsif ($article_stat ne /^\s*$/) { print qq!!, qq!$article_stat !; } else { print qq! !; } print $cgi->extcode(<<"----------END;"); [$name] $subject (via cgi) ($date)
[$misc_info]
----------END; $content = quotehtml($board_value{$id}); print $cgi->extcode(<<"----------END;");

Name:

Subject:

In-Reply-To:

Content:

----------END; } # Replace Checked Articles print $cgi->extcode(<<"----------END;"); $Default_Rule ----------END; # footer print $cgi->extcode(<<"----------END;");
$Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_article_delete { check_bbslock("Can't delete article"); unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_and_die("Invalid user-id or wrong password"); } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); print_syslog("board_article_delete"); my $filename = $cgi_value{'board_filename'}; my $link = $board_dir . "/" . $board_id . $board_suffix; my $file = $board_dir . "/" . $filename; my ($seq, $suffix) = ( $filename =~ /^\Q$board_id\E([0-9]{$board_seqlen})(.*)$/ ); my $log_filename = $board_id . $seq . $boardlog_suffix; my $log_file = $boardlog_dir . "/" . $log_filename; $board->splice(0); # clear $board->content $boardlog->splice(0); # clear $boardlog->content my @id_list = map { /^checked_($board_id.*)$/ } keys %cgi_value; my ($status, @deleted) = $board->board_delete($filename, @id_list); filelock($link) or print_and_die("$link: locked"); open LOG, $log_file or fileunlock($link), print_and_die("$log_file: $!"); $boardlog->read_htmldata(\*LOG); close LOG; my ($id, $n, $value); my $datem = localdate('M'); foreach $id (@id_list) { foreach $n (0..$#{$boardlog->content}) { if ($boardlog->content($n, 'name') eq $id) { $value = $boardlog->content($n, 'value'); $value =~ s/^((?:.|\n)*?),(?:.|\n)*?,((?:.|\n)*)$/$1,deleted$datem,$2/; $boardlog->content($n, 'value', $value); last; } } } open LOG, ">$log_file" or fileunlock($link), print_and_die("$log_file: $!"); $boardlog->print_htmldata(\*LOG); close LOG; fileunlock($link); my (@next, $next); $next[0] = sprintf("%s%0${board_seqlen}d%s", $board_id, $seq + 1, $suffix); $next[1] = sprintf("%s%0${board_seqlen}d%s", $board_id, $seq + 1, $board_suffix); foreach (@next) { if (-f $board_dir . "/" . $_) { $next = $_; last; } } if (defined $next) { update_board_style($next, $filename); } print_content_type(); # header print $cgi->extcode(<<"----------END;"); Checked Articles in $filename Deleted $Banner $Default_Rule

Checked Articles in $filename Deleted

Read $filename (via cgi), Read Current Board (via cgi)

----------END; # list of deleted articles if (@deleted) { print $cgi->extcode(<<"----------END;"); $Default_Rule

List of Deleted Articles

----------END; foreach (@deleted) { print $cgi->extcode($_->{'value'}); } } else { print $cgi->extcode(<<"----------END;"); $Default_Rule

No Article Deleted

----------END; } # footer print $cgi->extcode(<<"----------END;"); $Default_Admin_Footer ----------END; return 1; } #------------------------------------------------------------------------------ sub board_edit_form { my $filename = $cgi_value{'board_filename'}; my $link = $board_dir . "/" . $board_id . $board_suffix; $filename = readlink $link if $filename eq ""; my $file = $board_dir . "/" . $filename; my ($seq, $suffix) = ( $filename =~ /^\Q$board_id\E([0-9]+)(.*)$/ ); my $log_filename = $board_id . $seq . $boardlog_suffix; my $log_file = $boardlog_dir . "/" . $log_filename; unless (match_cgi_password($admin_userid, $admin_passwd) || match_cgi_password($board_userid, $board_passwd)) { print_errorlog("board_edit_form: invalid user-id or wrong password"); print_content_type(); print $cgi->extcode(<<"----------END;"); User-ID and Password $Default_Rule

User-ID and Password

$Board_Menu $Default_Rule
$inputform_passwd

$Default_Admin_Footer ----------END; return undef; } my $inputform_passwd = inputform_passwd("", "", "", $cgi_userid, $cgi_passwd); if ($filename !~ /^\Q$board_id\E[0-9]{$board_seqlen}\./) { print_and_die("$filename: forbidden access"); } elsif (! -f $file) { print_and_die("$file: not found"); } elsif (! -f $log_file) { print_and_die("$log_file: not found"); } print_syslog("board_edit_form"); $board->splice(0); # clear $board->content $boardlog->splice(0); # clear $boardlog->content print_content_type(); # header print $cgi->extcode(<<"----------END;"); Editing Form for Board File $filename $Banner $Default_Rule

Editing Form for Board File $filename

Read $filename (via cgi), Read Current Board (via cgi)

$Default_Rule $inputform_passwd ----------END; # List of Articles print $cgi->extcode(<<"----------END;"); $Default_Rule

List of Articles in $filename

----------END; open LOG, $log_file or print_and_die("$log_file: $!"); $boardlog->read_htmldata(\*LOG); close LOG; my ($id, $sid, $article_stat, $name, $subject, $replyto, $date, $passwd); my ($remote_host, $http_user_agent, $http_x_forwarded_for, $http_cookie); my $misc_info; foreach (@{$boardlog->content}) { $id = $_->{'name'}; ($sid, $article_stat, $name, $subject, $replyto, $date, $passwd, $remote_host, $http_user_agent, $http_x_forwarded_for, $http_cookie) = map { unquotecomm($_) } split /,/, $_->{'value'}; $name =~ s!<[^>]*>!!g; $subject =~ s!<[^>]*>!!g; $replyto =~ s!<[^>]*>!!g; $date =~ s!<[^>]*>!!g; $name = quotehtml($name); $subject = quotehtml($subject); $subject = $id if $subject =~ /^\s*$/; $replyto = quotehtml($replyto); $remote_host = quotehtml($remote_host); $http_user_agent = quotehtml($http_user_agent); $http_x_forwarded_for = quotehtml($http_x_forwarded_for); $http_cookie = quotehtml($http_cookie); $misc_info = qq!"$remote_host", "$http_user_agent", ! . qq!"$http_x_forwarded_for", "$http_cookie", "$passwd"!; if ($article_stat =~ /^del/) { print qq! o $article_stat !; } elsif ($article_stat ne /^\s*$/) { print qq!!, qq!$article_stat !; } else { print qq! !; } print $cgi->extcode(<<"----------END;"); [$name] $subject (via cgi) ($date)
[$misc_info]
----------END; } print $cgi->extcode(<<"----------END;");

----------END; # Edit Checked Articles print $cgi->extcode(<<"----------END;"); $Default_Rule ----------END; # Delete Checked Articles print $cgi->extcode(<<"----------END;"); $Default_Rule ----------END; # footer print $cgi->extcode(<<"----------END;");
$Default_Admin_Footer ----------END; return 1; } #============================================================================== # Submission #------------------------------------------------------------------------------ sub board_new { check_bbslock("Can't new board"); my $self = shift; my ($current, $previous) = @_; $self->header(macroexpand($macro, $config_value{'board_header'})); $self->footer(macroexpand($macro, $config_value{'board_footer'})); return 1; } #------------------------------------------------------------------------------ sub submit_article { check_bbslock("Can't submit article"); my ($mode) = @_; my ($context, $style) = split /_/, $mode; if ($access_restriction =~ /\b(?:submit|submission|post)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } if ($config_value{'status'} =~ /^(?:off|stop|no|reject)$/i) { print_and_die("submission rejected: ", "current board status \"$config_value{'status'}\""); } elsif ($ENV{'REQUEST_METHOD'} !~ /^POST$/i) { print_and_die("$ENV{'REQUEST_METHOD'}: bad request method for submission"); } elsif (! defined $style) { print_and_die("submit_article: article style undefined"); } elsif ($cgi_value{'_name'} =~ /^\s*$/) { print_and_die("submit_article: empty name"); } elsif ( ($cgi_value{'_body'} =~ /^\s*$/) && ($cgi_value{'_file'} =~ /^\s*$/) ) { print_and_die("submit_article: empty article body"); } elsif ($cgi_value{'submission_id'} eq "") { print_and_die("submit_article: empty submission-id"); } elsif ($cgi_value{'submission_id'} !~ m!^$board_id[0-9]+!) { print_and_die("submit_article: bad submission-id"); } my $link = $board_dir . "/" . $board_id . $board_suffix; filelock($link) or print_and_die("$link: locked"); $macro = board_macro('board_' . $style); $macro->{'FORMATTED_ARTICLE'} = macroexpand($macro, $article_format{$style}); ($macro->{'CHECK_HTML_ERROR'}, $macro->{'CHECK_HTML_HINT'}) = check_html($config_value{'html_tag_withend'}, $config_value{'html_tag_noend'}, $macro->{'FORMATTED_ARTICLE'}, $config_value{'html_forbidden_patterns'}); if ($config_value{'html_tag_restriction'} =~ /^rest/i && $macro->{'CHECK_HTML_ERROR'} ne "") { fileunlock($link); my $error = quotehtml($macro->{'CHECK_HTML_ERROR'}); my $hint = quotehtml($macro->{'CHECK_HTML_HINT'}); print_content_type(); print $cgi->extcode(<<"----------END;"); HTML Error $Banner $Default_Rule

HTML Error

$Default_Rule

Error

$error
$Default_Rule

Hint

$hint
$Default_Admin_Footer ----------END; exit; } my $id = $macro->{'ID'}; my $sid = $cgi_value{'submission_id'}; my ($old_id, $old_sid); foreach (@{$boardlog->content}) { $old_id = $_->{'name'}; ($old_sid) = split /,/, $_->{'value'}; if ($id eq $old_id) { fileunlock($link); print_and_die("$id: article with same id already exists"); } elsif ($sid eq $old_sid) { fileunlock($link); print_and_die("$sid: article with same submission-id already exists"); } } my $articlelog = $sid; $articlelog .= "," . ""; $articlelog .= "," . quotecomm($macro->{'name'}); $articlelog .= "," . quotecomm($macro->{'subject'}); $articlelog .= "," . quotecomm($macro->{'replyto'}); $articlelog .= "," . quotecomm($macro->{'DATE_S'}); $articlelog .= "," . quotecomm($macro->{'passwd'}); $articlelog .= "," . quotecomm($macro->{'REMOTE_HOST'}); $articlelog .= "," . quotecomm($macro->{'HTTP_USER_AGENT'}); $articlelog .= "," . quotecomm($macro->{'HTTP_X_FORWARDED_FOR'}); $articlelog .= "," . quotecomm($macro->{'HTTP_COOKIE'}); $boardlog->set_content({ 'name' => $id, 'value' => $articlelog }); my $article = $macro->{'HR'} . "\n" . $macro->{'FORMATTED_ARTICLE'}; $board->set_content({ 'name' => $id, 'value' => $article }); fileunlock($link); my ($stat, $current, $previous) = $board->board_addtop; if($stat eq "locked") { print_and_die("$current: locked") } $boardlog->board_maxsize(0) if $stat eq 'new' && defined $previous; my ($logstat, $logcurrent, $logprevious) = $boardlog->board_addtop; $boardlog->board_maxsize($boardlog_maxsize); print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'submission_completed'})); print_syslog("submit_article succeeded"); return 1; } #------------------------------------------------------------------------------ sub submission_form { my ($mode) = @_; my ($context, $style) = split /_/, $mode; if ($access_restriction =~ /\b(?:read|submission_form)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } # print_syslog("submission_form"); $macro = board_macro($mode); if (defined $style) { $macro->{'FORMATTED_ARTICLE'} = macroexpand($macro, $article_format{$style}); ($macro->{'CHECK_HTML_ERROR'}, $macro->{'CHECK_HTML_HINT'}) = check_html($config_value{'html_tag_withend'}, $config_value{'html_tag_noend'}, $macro->{'FORMATTED_ARTICLE'}, $config_value{'html_forbidden_patterns'}); } print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'submission_form'})); return 1; } #============================================================================== # Search Board sub board_search { if ($access_restriction =~ /\b(?:read|search)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } $macro = board_macro('search'); $macro->{'c'} = 0 unless defined $macro->{'c'}; # read via cgi $macro->{'k'} = "" unless defined $macro->{'k'}; # key or search expression $macro->{'o'} = 0 unless defined $macro->{'o'}; # order $macro->{'r'} = "" unless defined $macro->{'r'}; # range $macro->{'s'} = 0 unless defined $macro->{'s'}; # style # options my $read_via_cgi = $macro->{'c'}; my $key = $macro->{'k'}; my $order_normal = $macro->{'o'}; my $range = $macro->{'r'}; my $style_articles = $macro->{'s'}; my $current_seq = $macro->{'STAT_NEXT'} ? $macro->{'PREVIOUS_SEQ'} : $macro->{'CURRENT_SEQ'}; # header print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'search_header'})); if ($key eq "") { print $cgi->extcode($macro->{'FOOTER'}); return undef; } else { print_searchlog($key, $order_normal, $range, $style_articles, $read_via_cgi); } # parse order and range my ($begin, $hyphen, $end) = split(/(-)/, $range); if (defined $hyphen) { if ($end eq "") { $end = $current_seq } } else { if (defined $begin) { $end = $begin } else { $begin = 0; $end = $current_seq } } $begin = int($begin); $end = int($end); if ($begin > $end) { my $tmp = $begin; $begin = $end; $end = $tmp } $begin = 0 if $begin < 0; $end = $current_seq if $begin > $current_seq; my ($start, $step); if ($order_normal) { $step = 1; $start = $begin } else { $step = -1; $start = $end } # search unless ($style_articles) { print "
    \n"; } my ($n, $filename, $file, $read_url); my ($log_filename, $log_file); my ($boardlog_value, %boardlog_value, $id, $line, $idxline); for ($n = $start; $begin <= $n && $n <= $end; $n += $step) { $filename = sprintf("%s%0${board_seqlen}d%s", $board_id, $n, $board_suffix); $file = $board_dir . "/" . $filename; next unless -f $file; $board->splice(0); # clear $board->content open FILE, $file or next; $board->read_htmldata(\*FILE); close FILE; $board->reverse if $order_normal; if ($style_articles) { foreach (@{$board->content}) { $id = $_->{'name'}; if ($_->{'value'} =~ /$key/i) { print $cgi->extcode("\n" . $_->{'value'}); } } } else { $log_filename = sprintf("%s%0${board_seqlen}d%s", $board_id, $n, $boardlog_suffix); $log_file = $board_dir . "/" . $log_filename; next unless -f $log_file; $boardlog->splice(0); # clear $boardlog->content open LOG, $log_file or next; $boardlog->read_htmldata(\*LOG); close LOG; $boardlog_value = $boardlog->last_value_index; %boardlog_value = %$boardlog_value; if ($read_via_cgi) { if ($order_normal) { $read_url = "$READ_CGI_URL?b=$board_id&normal&_f=$filename"; } else { $read_url = "$READ_CGI_URL?b=$board_id&_f=$filename"; } } else { $read_url = $board_dir_url . "/" . $filename; } foreach (@{$board->content}) { $id = $_->{'name'}; $line = $boardlog_value{$id}; if ($_->{'value'} =~ /$key/i) { $idxline = article_index_line($read_url, $id, $line, q!target="article"!); print $cgi->extcode("
  • " . $idxline . "\n") if defined $idxline; } } } } if ($style_articles) { print "\n"; } else { print "
\n"; } # footer print $cgi->extcode($macro->{'FOOTER'}); return 1; } #============================================================================== # Old Logs sub board_old_logs { if ($access_restriction =~ /\b(?:read|old_logs|old)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } $macro = board_macro('old_logs'); $macro->{'c'} = 0 unless defined $macro->{'c'}; # read via cgi $macro->{'o'} = 0 unless defined $macro->{'o'}; # order $macro->{'r'} = "" unless defined $macro->{'r'}; # range # options my $read_via_cgi = $macro->{'c'}; my $order_normal = $macro->{'o'}; my $range = $macro->{'r'}; my $current_seq = $macro->{'STAT_NEXT'} ? $macro->{'PREVIOUS_SEQ'} : $macro->{'CURRENT_SEQ'}; # parse range my ($begin, $hyphen, $end) = split(/(-)/, $range); if (defined $hyphen) { if ($end eq "") { $end = $current_seq } } else { if (defined $begin) { $end = $begin } else { $begin = 0; $end = $current_seq } } $begin = int($begin); $end = int($end); if ($begin > $end) { my $tmp = $begin; $begin = $end; $end = $tmp } $begin = 0 if $begin < 0; $end = $current_seq if $begin > $current_seq; # get filenames opendir DIR, $board_dir or print_and_die("$board_dir: $!"); my @filename = sort grep { /^\Q$board_id\E([0-9]+)\.\w+$/ && $begin <= $1 && $1 <= $end } readdir DIR; closedir DIR; @filename = reverse @filename unless $order_normal; # header print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'old_logs_header'})); # print old log index print $cgi->extcode($macro->{'HR'}), "\n"; print "
\n";
  my ($seq, $size, $mtime, $read);
  foreach (@filename) {
    ($seq) = ( $_ =~ /^\Q$board_id\E([0-9]+)\.\w+$/ );
    ($size, $mtime)= (stat $board_dir . "/" . $_)[7,9];
    if ($read_via_cgi) {
      if ($order_normal) {
	$read = qq!$board_id$seq!;
      } else {
	$read = qq!$board_id$seq!;
      }
      printf "%8d %s %s %s\n",
        $size,
        localdate('S', $mtime),
        $read,
        qq!(index, thread)!;
    } else {
      $read = qq!$board_id$seq!;
      printf "%8d %s %s %s\n",
        $size,
        localdate('S', $mtime),
        $read,
        qq!(index, thread)!;
    }
  }
  print "
\n"; # footer print $cgi->extcode($macro->{'FOOTER'}); return 1; } #============================================================================== # Index sub board_index { if ($access_restriction =~ /\b(?:read|index)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } # $log_file my $filename = $cgi_value{'_f'}; if (defined $filename && $filename !~ /^\Q$board_id\E[0-9]+\./) { print_and_die("$filename: invalid filename"); } if (! defined $filename || $filename =~ /^\s*$/) { my $link = $board_dir . "/" . $board_id . $board_suffix; unless (-l $link) { print_and_die("$link: not symbolic link"); } $filename = readlink $link; } my ($seq) = ($filename =~ /^\Q$board_id\E([0-9]+)\./); # make macros $macro = board_macro('index'); $macro->{'f'} = $filename unless defined $macro->{'f'}; # filename $macro->{'c'} = 0 unless defined $macro->{'c'}; # read via cgi $macro->{'o'} = 0 unless defined $macro->{'o'}; # order $macro->{'SEQ'} = $seq; # options my $read_via_cgi = $macro->{'c'}; my $order_normal = $macro->{'o'}; # load board logs $boardlog->splice(0); # clear $boardlog->content my ($log_filename, $log_file); $log_filename = sprintf("%s%0${boardlog_seqlen}d%s", $boardlog_id, $seq, $boardlog_suffix); $log_file = $boardlog_dir . "/" . $log_filename; open LOG, $log_file or print_and_die("$log_file: $!"); $boardlog->read_htmldata(\*LOG); close LOG; $boardlog->reverse if $order_normal; # output index my $opt; if ($read_via_cgi) { if ($order_normal) { $opt = "$READ_CGI_URL?b=$board_id&normal&_f="; } else { $opt = "$READ_CGI_URL?b=$board_id&_f="; } } else { $opt = "$board_dir_url/"; } print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'index_header'})); print $cgi->extcode($macro->{'HR'}), "\n"; print "
    \n"; my ($id, $line, $idxline); foreach (@{$boardlog->content}) { $id = $_->{'name'}; $line = $_->{'value'}; $idxline = article_index_line($opt . $filename, $id, $line, q!target="article"!); print $cgi->extcode("
  • " . $idxline . "\n") if defined $idxline; } print "
\n"; print $cgi->extcode($macro->{'FOOTER'}); return 1; } #============================================================================== # Threaded Index sub board_thread { if ($access_restriction =~ /\b(?:read|thread)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } # $filename and $fileseq my $filename = $cgi_value{'_f'}; if (defined $filename && $filename !~ /^\Q$board_id\E[0-9]+\./) { print_and_die("$filename: invalid filename"); } if (! defined $filename || $filename =~ /^\s*$/) { my $link = $board_dir . "/" . $board_id . $board_suffix; unless (-l $link) { print_and_die("$link: not symbolic link"); } $filename = readlink $link; } my $file = $board_dir . "/" . $filename; unless (-f $file) { print_and_die("$file: not found"); } my ($fileseq) = ($filename =~ /^\Q$board_id\E([0-9]+)\./); # make macros $macro = board_macro('thread'); $macro->{'f'} = $filename unless defined $macro->{'f'}; # filename $macro->{'c'} = 0 unless defined $macro->{'c'}; # read via cgi $macro->{'o'} = 0 unless defined $macro->{'o'}; # order $macro->{'h'} = int(128*1024/$board->board_maxsize) unless defined $macro->{'h'}; # half span $macro->{'h'} = 0 if $macro->{'h'} < 0; # options my $read_via_cgi = $macro->{'c'}; my $order_normal = $macro->{'o'}; my $halfspan = $macro->{'h'}; my $current_seq = $macro->{'STAT_NEXT'} ? $macro->{'PREVIOUS_SEQ'} : $macro->{'CURRENT_SEQ'}; # range my $begin = $fileseq - $halfspan; my $end = $fileseq + $halfspan; if ($begin < 0) { $begin = 0; $end = $begin + 2*$halfspan } if ($end > $current_seq) { $end = $current_seq; $begin = $end - 2*$halfspan } $begin = 0 if $begin < 0; # load board logs $boardlog->splice(0); # clear $boardlog->content my ($n, $log_filename, $log_file, @filename); my $last_num = 0; for ($n = $end; $n >= $begin; $n--) { $log_filename = sprintf("%s%0${boardlog_seqlen}d%s", $boardlog_id, $n, $boardlog_suffix); $log_file = $boardlog_dir . "/" . $log_filename; next unless -f $log_file; open LOG, $log_file or next; $boardlog->read_htmldata(\*LOG); close LOG; next unless @{$boardlog->content}; $filename = sprintf("%s%0${board_seqlen}d%s", $board_id, $n, $board_suffix); foreach ($last_num .. $#{$boardlog->content}) { $filename[$_] = $filename; } $last_num = $#{$boardlog->content} + 1; } # return if $boardlog->content is empty unless (@{$boardlog->content}) { print_errorlog("thread index is empty"); print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'thread_header'})); print $cgi->extcode($macro->{'HR'}), "\n"; print "

Thread Index is Empty.

\n"; print $cgi->extcode($macro->{'FOOTER'}); return undef; } # make id-to-num index my $num = $boardlog->last_num_index; # make thread data # # $follower{$id} = [ $follower_num1, $follower_num2, ... ]; # @root = ( $root_num1, $root_num2, ... ); # my ($replyto, @follower, @root); foreach $n (0..$#{$boardlog->content}) { $follower[$n] = []; } foreach $n (0..$#{$boardlog->content}) { $replyto = unquotecomm((split /,/, $boardlog->content($n, 'value'))[4]); $replyto =~ s/^.*\#//; if (exists $num->{$replyto}) { push @{$follower[$num->{$replyto}]}, $n; } else { push @root, $n; } } @root = reverse @root if $order_normal; # output threaded index my $opt; if ($read_via_cgi) { if ($order_normal) { $opt = "$BBS_CGI_URL?b=$board_id&normal&_f="; } else { $opt = "$READ_CGI_URL?b=$board_id&_f="; } } else { $opt = "$board_dir_url/"; } print_content_type(); print $cgi->extcode(macroexpand($macro, $config_value{'thread_header'})); print $cgi->extcode($macro->{'HR'}), "\n"; print "
\n";
  my $l = 0;
  my $f = "";
  my $threaded_index;
  foreach $n (@root) {
    print "\n" if ($l || scalar @{$follower[$n]}) && $f ;
    $threaded_index = "";
    make_threaded_index(\$threaded_index,
			$num, \@filename, \@follower, $opt, $n, "",
			$order_normal);
    print $cgi->extcode($threaded_index);
    $l = scalar @{$follower[$n]};
    $f = 1;
  }
  print "
\n"; print $cgi->extcode($macro->{'FOOTER'}); return 1; } #------------------------------------------------------------------------------ sub make_threaded_index { my ($threaded_index, $num, $filename, $follower, $opt, $n, $indent, $order_normal) = @_; my ($file, $id, $line, $idxline); if (length $indent >= 1024) { $idxline = $indent . qq|Too deep!\n|; if ($order_normal) { $$threaded_index .= $idxline; } else { $$threaded_index = $idxline . $$threaded_index; } return; } $file = $opt . $filename->[$n]; $id = $boardlog->content($n, 'name'); $line = $boardlog->content($n, 'value'); my $art_idxline = article_index_line($file, $id, $line, q!target="article"!); $idxline = $indent . $art_idxline . "\n" if defined $art_idxline; if ($order_normal) { $$threaded_index .= $idxline; } else { $$threaded_index = $idxline . $$threaded_index; } if (@{$follower->[$n]}) { foreach (reverse @{$follower->[$n]}) { make_threaded_index($threaded_index, $num, $filename, $follower, $opt, $_, $indent . " ", $order_normal); } } } #============================================================================== # Read Board sub read_board { if ($access_restriction =~ /\b(?:read)\b/i) { my ($check_access_status, $check_access_error) = check_access(\$access_conf, \$passwd_table, \$group_table, $cgi_userid, $cgi_passwd); unless ($check_access_status) { print_and_die($check_access_error); } } # options my $order_normal = 1 if exists $cgi_value{'normal'}; $order_normal = $cgi_value{'_o'} unless defined $order_normal; my $order_option = ""; $order_option = "normal&" if $order_normal; # $filename and $file my $filename = $cgi_value{'_f'}; if (defined $filename && $filename !~ /^\Q$board_id\E[0-9]+\./) { print_and_die("$filename: invalid filename"); } if (! defined $filename || $filename =~ /^\s*$/) { my $link = $board_dir . "/" . $board_id . $board_suffix; unless (-l $link) { print_and_die("$link: not symbolic link"); } $filename = readlink $link; } my $file = $board_dir . "/" . $filename; unless (-f $file) { print_and_die("$file: not found"); } my $referer = $ENV{'HTTP_REFERER'}; # print_syslog("read_board: $filename,$order_normal,$referer"); # load $file open FILE, $file or print_and_die("$file: $!"); $board->read_htmldata(\*FILE); close FILE; # if $order_normal, do reverse $board->reverse if $order_normal; # replace url to read via cgi $board->{'header'} =~ s!(]*\bhref=\"?)($board_id[0-9]+\.\w+)(|\#$board_id[0-9]+)!$1$READ_CGI_URL?b=$board_id&${order_option}_f=$2$3!ig; $board->{'footer'} =~ s!(]*\bhref=\"?)($board_id[0-9]+\.\w+)(|\#$board_id[0-9]+)!$1$READ_CGI_URL?b=$board_id&${order_option}_f=$2$3!ig; foreach (@{$board->content}) { $_->{'value'} =~ s!(]*\bhref=\"?)($board_id[0-9]+\.\w+)(|\#$board_id[0-9]+)!$1$READ_CGI_URL?b=$board_id&${order_option}_f=$2$3!ig; } # print out my $mtime = (stat $file)[9]; print "Last-Modified: ", localdate('L', $mtime, 0), " GMT\n"; print_content_type(); $board->print_htmldata(\*STDOUT); return 1; } #============================================================================== # Make Board Macro # 1. board_macro($mode) returns a referrence to basic macro hash data # and loads logged article data into $boardlog. # # $mode = {board|submission|search|index}_