#!/usr/bin/perl # FlasH BBS Pro version 1.40 # # Script written by Shigeto Nakazawa.(1997/1/17) # < http://www7.big.or.jp/~jawa/ > # This script is free. # ////////////////////////////////////////////////////////// # // Option settings // # ////////////////////////////////////////////////////////// # ---------------------------------------------------------- # setting the number of max articles # ---------------------------------------------------------- $max_size = 300 *1024; # article deletion file size (min 1500) $max_tree = 15; # number of list under each tree $max_msg = 8000; # number of words per mesg $new_kiji = 10; # how many "new"s to put # ---------------------------------------------------------- # My info as the administrator # ---------------------------------------------------------- $admin_name = 'Kaboom!'; # admin name $admin_email = 'kaboom@kaboom.orion.tj'; # admin email # ---------------------------------------------------------- # custimizing this BBS # ---------------------------------------------------------- $title = "Saryrn Guild BBS Pro v1.40"; # BBS title $body = ''; #Body $backurl = "http://www.csua.berkeley.edu/~hosaka/EQ/"; # Back URL $date = "year/mon/day hour:min"; # time & date format $date_type = 1; # fix one line to 2 lines? # no=0, yes=1, all=2 $em_color = "#EE0033"; # color for emphasis $kiji_title_color = "#EEEEFF"; # article title color $kiji_title_bgcolor = "#261B10"; # title background color $form_bgcolor = "#EED155"; # submit form background color $res_color = "#444499"; # response color $gif_allnews = '../../all_news.gif'; # GIF IMAGE for read all at once $gif_news = '../../news.gif'; # GIF IMAGE for regular reading $gif_new_news = '../../new_news.gif'; # GIF IMAGE for newest article $gif_space = '../../space.gif'; # clear GIF IMAGE for dummy purpose $gif_width = 20; # GIF IMAGE width $gif_height = 14; # GIF IMAGE height $tree_width = 30; # Tree Width $html_title=<<"_EOF_"; # HTML setting
Saryrn Guild BBS

_EOF_ # this _EOF_ is necessary $html_info=<<"_EOF_"; # HTML setting

Welcome to FlasH BBS Pro!

_EOF_ # this _EOF_ is necessary # ---------------------------------------------------------- # Cookie file and security # do not change unless necessary # ---------------------------------------------------------- $base_url = ""; # by writing the URL for CGI-bin, the illegal # submissions are elminiated $cookie_name = 'fbbspro'; # cookie ID $jcode = './jcode.pl'; # jcode.pl location (NOT URL) $logfile = './flashbbs.log'; # record file (NOT URL) $countfile = './flashbbs.cnt'; # counter file (NOT URL) $lock1 = './fbbs1.lock'; # lock file (1) (NOT URL) $lock2 = './fbbs2.lock'; # lock file (2) (NOT URL) $lock_flag = 1; # use lock file: 1=yes, 0=no # ////////////////////////////////////////////////////////// # // option changes end here // # ////////////////////////////////////////////////////////// # [main body] # $ID = $FORM{'id'}; &check_code; &read_form; &get_cookie; &check_cookie; @logs = &read_file($logfile); if ($FORM{'md'} eq 'reg') { ®ist; } elsif ($FORM{'md'} eq 'del') { &delete; } elsif ($FORM{'md'} eq 'viw') { &view; } elsif ($FORM{'md'} eq 'new') { &html_header("New Thread");print"


\n";&html_form('root'); } elsif ($FORM{'md'} eq 'set') { &set; } elsif ($FORM{'md'} eq 'num') { &number; } else { &ichiran; } &html_footer; exit 0; # [Header] # sub html_header { local($sub_title) = $_[0]; local($font_size) = ($COOKIE{'font'} > 0) + 3; print "Content-type: text/html\n\n"; print<<"_EOF_"; $title [$sub_title] $body high elf girl $html_title
[ Guild Homepage / Help (Japanese) / View All / Read Newest / Submit Article / Administrator ]

_EOF_ } # [Showing the Author (make sure to do it)] # sub html_footer { print<<"_EOF_";


BBS Admin: $admin_name : FlasH BBS Pro v1.40 [Shigeto Nakazawa]
_EOF_ } # [All at once] # sub ichiran { &set_cookie; &html_header("View All"); $count = (&read_file($countfile))[0]; $tree = $COOKIE{'tree'}; if ($tree > @logs) { $tree = 0; } if (!$tree) { $tree = 0; } $tree = int($tree/$max_tree)*$max_tree; print<<"_EOF_"; $html_info
_EOF_ print"
\n";
    $end_tree = $tree + $max_tree;
    if ($end_tree > @logs) { $end_tree = @logs; }
    for ($i=$tree;$i<$end_tree;$i++) {
        print"
"; @datas = ÷_log($logs[$i]); foreach (@datas) { local($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($_); if ($res eq 'root') { print ""; } else { local($space_width) = $gif_width+$tree_width*$lx; print ""; } print ""; if ($no > $count - $new_kiji) { print ""; } else { print ""; } print "$title : "; if ($COOKIE{'name'} eq $name) { print "$name"; } else { print $name; } print " ($date)\n"; } } print"
\n"; } # [Show each of the articles ] # sub view { &html_header("Article:($FORM{'no'})"); @kiji_datas = ÷_log(&search_no2data($FORM{'tn'},@logs)); $kiji_data = &search_no2data($FORM{'no'},@kiji_datas); print"
\n"; &kiji_view($kiji_data); print"
\n"; local($no,$rq_res,$lx,$tn,$title,$name,$email,$date,$rq_act,$file_pwd,$rhost,$ipad,$comment) = ÷_data($kiji_data); foreach (@kiji_datas) { local($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($_); if ($rq_res == $no) { $parent = "-$title : $name($date)\n"; } if (($res == $FORM{'no'}) && ($res ne 'root')) { $children .= "/>$title : $name($date)\n"; } } if ($rq_res eq 'root') { $parent = "This is the root article"; } elsif (!$parent) { $parent = "Could not find the root article"; } if (!$children) { $children = "There was no response."; } print<<"_EOF_";
[This is the root article]

$parent


[Response to this article]

$children


To submit the response, please fill in the below
_EOF_ if ($rq_act > 6) { print "

Unfortunately, could not write a response
\n"; return 0; } if ($title =~ /^Re\[(\d+)\]:/){ local($ct) = $1; $ct++; $title =~ s/Re\[\d+\]:/Re\[$ct\]:/; } elsif ($title =~ /^Re:/){ $title =~ s/Re:/Re\[2\]:/; } else { $title = "Re:$title"; } $comment = "
$comment"; $comment =~ s/
((>)+)/\n$1>/ig; $comment =~ s/
/\n> /ig; $comment =~ s/\n//; &html_form($FORM{'no'},$title,$comment,$FORM{'tn'},$lx); if (crypt($COOKIE{'pwd'},"FlasH_BBS_Pro") eq $file_pwd) { print<<"_EOF_";
Sometimes it is not removed completely.
_EOF_ } } # [Set Display] # sub set { &html_header("Set Display"); print<<"_EOF_";
Set Display

_EOF_
    @kiji_datas = ÷_log(&search_no2data($FORM{'tn'},@logs));
    foreach (@kiji_datas) {
        local($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($_);
        $no = int($no);
        $reply[$res] .= "$no-";
        if ($res eq 'root') {
            print "";
        } else {
            local($space_width) = $gif_width+$tree_width*$lx;
            print "";
        }
        print "$title : $name($date)\n";
    }
    foreach $data (@kiji_datas) {
        local($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($data);
        $no = int($no);
        print<<"_EOF_";


Reply|List
$no _EOF_ if ($res eq 'root') { print" Root\n"; } else { $res = int($res); print"-[$res]\n"; } print"\n"; if (!$reply[$no]) { print"None\n"; } else { chop($reply[$no]); local(@replys) = split(/-/,$reply[$no]); foreach (@replys) { print"\>[$_]\n"; } } print"
\n"; &kiji_view($data); print<<"_EOF_";

_EOF_ } } # [View All Handle] # sub number { &html_header("New Article"); print<<"_EOF_";
Showing $new_kiji new articles.
_EOF_ $count = (&read_file($countfile))[0]; foreach (@logs) { @datas = ÷_log($_); foreach $data (@datas) { local($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($data); if ($no > $count - $new_kiji) { push(@nums,$data); } } } @nums = reverse(sort(@nums)); foreach $data (@nums) { local($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($data); print<<"_EOF_";


Reply this Article|Display by set
_EOF_ &kiji_view($data); print<<"_EOF_";

_EOF_ } } # [Submission form] # sub html_form { local($no,$title,$comment,$tn,$lx) = (@_); if ($no eq '') { $no = 'root'; } $nam_wid = 35; $com_wid = 72; $agent = $ENV{'HTTP_USER_AGENT'}; if ($agent =~ /MSIE 3/i) { $nam_wid = 65; $com_wid = 105; } elsif ($agent =~ /MSIE 4/i) { $nam_wid = 65; $com_wid = 70; } elsif (($agent =~ /[ja]/i) && ($agent =~ /3\./)) { $nam_wid = 46; $com_wid = 70; } print<<"_EOF_";
TITLE
NAME
EMAIL
_EOF_ } # [Displaying Article] # sub kiji_view { local($data) = $_[0]; local($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$tm_pwd,$rhost,$ipad,$comment) = ÷_data($data); $comment ="$comment"; &jcode'convert(*comment,'euc'); $comment =~ s/>(>[^<]*)/>$1<\/FONT>/g; $comment =~ s/(http:\/\/[\w\.\~\-\/\?\&\+\=\:\@\%]+)/
$1<\/A>/ig; $comment =~ s/(ftp:\/\/[\w\.\~\-\/]+)/$1<\/A>/ig; $comment =~ s/([\w\.\-]+)\@([\w\.\-]+)/$1\@$2<\/A>/ig; &jcode'convert(*comment,$mojicode); if ($email) { $name = "$name"; } print<<"_EOF_";
$title
$name($date)

$comment

_EOF_ } # [Form Handle] # sub regist { local($title,$name,$email,$comment,$lx,$tn,$pwd,$ref_url) = ($FORM{'title'},$FORM{'name'},$FORM{'email'},$FORM{'comment'},$FORM{'lx'},$FORM{'tn'},$FORM{'pwd'},$ENV{'HTTP_REFERER'}); $title =~ s/\r\n//g; $title =~ s/\r|\n//g; $name =~ s/\r\n//g; $name =~ s/\r|\n//g; $email =~ s/\r\n//g; $email =~ s/\r|\n//g; $comment =~ s/\r\n/
/g; $comment =~ s/\r|\n/
/g; $lx++; $pwd =~ s/\r\n//g; $pwd =~ s/\r|\n//g; $ref_url =~ s/\?(.|\n)*//g; s/\%7E/\~/g; if($base_url && ($ref_url !~ $base_url)){ &error(1,"Illegal access. $ref_url
\n"); } if (length($title) > 80) { &error(1,"Incorrect title or title length is over limit"); } elsif (!$title) { $title = "(No title)"; } if ((!$name) || (length($name) > 42)) { &error(1,"Missing name or name is over the limit"); } if ((($email !~ /(.*)\@(.*)\.(.*)/) && ($email)) || (length($email) > 120)) { &error(1,"email address incorrect or the length is over limit"); } if ((!$comment) || (length($comment) > $max_msg)) { &error(1,"Some info are missing or message over limit."); } if ((!$pwd) || (length($pwd) > 8)) { $pwd = &make_pwd; } $file_pwd = crypt($pwd,"FlasH_BBS_Pro"); &get_date; $count = (&read_file($countfile))[0]; if (++$count > 9999) { &error(1,"Counter Error. Administrator needs to refresh the counter."); } &write_file($countfile,$count); $count = substr("0000",length($count)).$count; $rhost = &change_code($ENV{'REMOTE_HOST'}); $ipad = &change_code($ENV{'REMOTE_ADDR'}); if ($FORM{'no'} eq 'root') { $kiji_data = "$count<>root<>0<>$count<>$title<>$name<>$email<>$date<>0<>$file_pwd<>$rhost<>$ipad<>$comment\n"; unshift(@logs,$kiji_data); } else { foreach $tree (@logs) { if ($tn == (split(/<>/,$tree))[0]) { @datas = ÷_log($tree); $flag1 = 0; $flag2 = 0; $kiji_data = "$count<>$FORM{'no'}<>$lx<>$tn<>$title<>$name<>$email<>$date<>0<>$file_pwd<>$rhost<>$ipad<>$comment"; foreach $data (@datas) { if (($flag2 == 1) && ($temp_lx >= (split(/<>/,$data))[2])){ $tree_data = "$tree_data<#>$kiji_data"; $flag2 = 2; } if ($flag1) { $tree_data = "$tree_data<#>$data"; } else { $tree_data = $data; $flag1 = 1; } if (($FORM{'no'} == (split(/<>/,$data))[0]) && (!$flag2)) { $flag2 = 1; $temp_lx = (split(/<>/,$data))[2]; } } if ($flag2 == 1){ $tree_data = "$tree_data<#>$kiji_data"; } unshift (@new,"$tree_data\n"); } else { push (@new,$tree); } } @logs = @new; } if ($max_size <1500) { $max_size = 1500; } $size = (stat($logfile))[7]; while ($size > $max_size) { $size -= length(pop(@logs)); } &write_file($logfile,@logs); $COOKIE{'name'} = $name; $COOKIE{'email'} = $email; $COOKIE{'pwd'} = $pwd; &set_cookie; &html_header("Submission Report"); print<<"_EOF_";

The article has been submitted as follows


_EOF_ &kiji_view($kiji_data); &html_footer; exit; } # [Article deletion] # sub delete { @kiji_datas = ÷_log(&search_no2data($FORM{'tn'},@logs)); $kiji_data = &search_no2data($FORM{'no'},@kiji_datas); local($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$file_pwd,$rhost,$ipad,$comment) = ÷_data($kiji_data); if (crypt($COOKIE{'pwd'},"FlasH_BBS_Pro") ne $file_pwd) { &error(1,"The selected article cannot be removed. "); } &get_date; $kazu = @kiji_datas; if ($kazu == 1) { foreach $data (@logs) { if ($FORM{'no'} != (split(/<>/,$data))[0]) { push(@new,$data); } } } else { $kiji_data = ""; $flag = 0; foreach $data (@kiji_datas) { if ($flag) { $tree_data .= "<#>"; } else { $flag = 1; } if ($FORM{'no'} == (split(/<>/,$data))[0]) { $tree_data .= $kiji_data; } else { $tree_data .= $data; } } $tree_data =~ s/\n//; foreach $data (@logs) { if ($FORM{'tn'} != (split(/<>/,$data))[0]) { push(@new,$data); } else { push(@new,"$tree_data\n"); } } } &write_file($logfile,@new); &html_header("Deleted by the writer"); print<<"_EOF_";

Article Deleted

If there are response articles following the deleted article, it may not be deleted completely.
If you want it to be completely removed, please contact the BBS Administrator.

_EOF_ } # [ Data Handle] # sub divide_log { local($data) = $_[0]; chop($data); return split(/<#>/,$data); } sub divide_data { return split(/<>/,$_[0]); } sub search_no2data { local($no,@datas) = @_; local($data); foreach $data (@datas) { if ($no == (split(/<>/,$data))[0]) { return $data; } } return 0; } # [Getting Data from Form] # sub read_form { local($pair,$buffer); if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } local(@pairs) = split(/&/,$buffer); foreach $pair (@pairs) { local($name,$value) = split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $FORM{$name} = &change_code($value); } } # [ Dealing with Cookies ] # sub check_cookie { local($text); foreach $text ('font','sort','tree','form','new_mail','res_mail') { if (($FORM{$text} ne '') && ($COOKIE{$text} ne $FORM{$text})) { $COOKIE{$text} = $FORM{$text}; } } } sub get_cookie { local($pair,%DUMMY); local($cookies) = $ENV{'HTTP_COOKIE'}; local(@pairs) = split(/;/,$cookies); foreach $pair (@pairs) { local($name,$value) = split(/=/,$pair); $name =~ s/ //g; $DUMMY{$name} = $value; } @pairs = split(/,/,$DUMMY{$cookie_name}); foreach $pair (@pairs) { local($name,$value) = split(/:/,$pair); $COOKIE{$name} = &change_code($value); } } sub set_cookie { local($cook) = "name\:$COOKIE{'name'}\,email\:$COOKIE{'email'}\,pwd\:$COOKIE{'pwd'}\,font\:$COOKIE{'font'}\,sort\:$COOKIE{'sort'}\,tree\:$COOKIE{'tree'}\,form\:$COOKIE{'form'}\,new_mail\:$COOKIE{'new_mail'}\,res_mail\:$COOKIE{'res_mail'}"; $ENV{'TZ'} = "GMT"; # International standard time local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time + 30*24*60*60); if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } if ($mday < 10) { $mday = "0$mday"; } if ($year < 10) { $year = "0$year"; } $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon]; $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday]; $date_gmt = "$youbi, $mday\-$mon\-$year $hour:$min:$sec GMT"; print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\n"; } # [Word codes] # sub check_code { if (!(-r $jcode)) { &error(1,"jcode.pl is missing"); } require $jcode; local($text) = ord(substr("中澤重人=じゃわ(^-^;;",0,1)); if ($text == 0xc3) { $mojicode = "euc"; $charset_code = "x-euc-jp"; } elsif ($text == 0x92) { $mojicode = "sjis";$charset_code = "x-sjis"; } else { &error(1,"This language is not supported"); } } sub change_code { local($text)=$_[0]; &jcode'convert(*text,$mojicode); if ($mojicode eq 'sjis') { &jcode'h2z_sjis(*text); } if ($mojicode eq 'euc') { &jcode'h2z_euc(*text); } $text =~ s//>/g; return $text; } # [Getting Date] # sub get_date { $ENV{'TZ'} = "JST-9"; # TimeZone (japan time =International Standard Time (JST) - 9hours) # (pacific time = JST-16) local($sec,$min,$hour,$day,$mon,$year) = localtime(); $mon++; if ($date_type) { if ($sec < 10) { $sec = "0$sec"; } # seconds if ($min < 10) { $min = "0$min"; } # minutes if ($hour > 12) { $min = "$min PM"; $hour = $hour-12} #changed...does it work? if ($date_type > 1) { if ($mon < 10) { $mon = "0$mon"; } # month if ($day < 10) { $day = "0$day"; } # day } } $year += 1900; $date =~ s/year/$year/ig; $date =~ s/mon/$mon/ig; $date =~ s/day/$day/ig; $date =~ s/hour/$hour/ig; $date =~ s/min/$min/ig; $date =~ s/sec/$sec/ig; } # [ Log files ] # sub read_file { local($logfile) = $_[0]; &lock_file($lock1);&lock_file($lock2); if ($lock_error) { &error(1,"Locked file was found. Please try again later"); } if (!open(IN,$logfile)) { &unlock_file; &error(1,"Unable to write to the log file"); } local(@files) = ; close(IN); &unlock_file($lock2);&unlock_file($lock1); return @files; } sub write_file { local($logfile,@lines) = @_; &lock_file($lock1);&lock_file($lock2); if ($lock_error) { &error(1,"Locked file was found. Please try again later"); } if (!open(OUT,">$logfile")) { &unlock_file; &error(1,"Unable to write to the log file"); } print OUT @lines; close(OUT); &unlock_file($lock2);&unlock_file($lock1); return @lines; } # [Locking] # sub lock_file { local($lockfile) = $_[0]; if (!$lock_flag) { return 1; } local($retry) = 5; while (-f $lockfile) { if ($retry-- <= 0) { local($mtime) = (stat($lockfile))[9]; if ($mtime < time()-60*15) { &unlock_file($lockfile); } $lock_error = 1; return 1; } sleep 1; } open (LOCK,">$lockfile"); close(LOCK); return 1; } sub unlock_file { local($lockfile) = $_[0]; unlink($lockfile); } # [ Passwords ] sub make_pwd { local($pwd) = ''; srand; for ($i=0;$i<8;$i++) { $pwd .= substr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",int(rand(62)),1); } return $pwd; } # [ ERRORS ] # sub error { ($err,$err_msg) = @_; if ($err) { print "Content-type: text/html\n\n"; } print<<"_EOF_";

ERROR:$err_msg
_EOF_ exit; }