BBS

#!/usr/bin/perl ############################################### # bbs41.cgi # V1.1 (2005.6.10) # Copyright(C) CGI-design ############################################### $script = 'bbs41.cgi'; $base = './bbsdata'; #データ格納ディレクトリ $bbsfile = "$base/bbs.txt"; #ログ $wordfile = "$base/word.cgi"; #禁止語 $opfile = "$base/option.txt"; #オプション $lockfile = "$base/lock"; #ロック @week = ('日','月','火','水','木','金','土'); open (IN,"$opfile") || &error("OPEN ERROR"); $opdata = ; close IN; if (!$opdata) { $pass = &crypt('cgi'); chmod(0666,$opfile); open (OUT,">$opfile") || &error("OPEN ERROR"); print OUT "$pass<>./bbs.htm<>10<>50"; close OUT; chmod(0666,$bbsfile); chmod(0666,$wordfile); } ###　メイン処理　### if ($ENV{'REQUEST_METHOD'} eq "POST") {read(STDIN, $in, $ENV{'CONTENT_LENGTH'});} else {$in = $ENV{'QUERY_STRING'};} foreach (split(/&/,$in)) { ($n,$val) = split(/=/); $val =~ tr/+/ /; $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $val =~ s/&/&/g; $val =~ s//>/g; $val =~ s/"/"/g; $val =~ s/\r\n|\r|\n/
/g; $in{$n} = $val; } $mode = $in{'mode'}; open (IN,"$opfile") || &error("OPEN ERROR"); ($pass,$tmpfile,$page,$logmax) = split(/<>/,); close IN; $num = $in{'num'}; $back = $num - $page; $next = $num + $page; if ($mode eq 'admin') {&admin;} else {&main;} exit; ### sub header { print "Content-type: text/html\n\n"; print "\n"; print "BBS\n"; print "\n"; $head = 1; } ### sub main { if ($in{'reg'}) {&newwrt;} &tmpread; &getcook; $tmp =~ s/!name/$name/; $tmp =~ s/!mail/$mail/; $tmp =~ s/!hp/$hp/; $m = -1; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { $m++; if ($m < $num) {next;} if ($next <= $m) {last;} ($no,$year,$mon,$mday,$wday,$hour,$min,$name,$mail,$hp,$sub,$com) = split(/<>/); &bbs_log; $tmp .= $data; } close IN; if (0 <= $back) {$tmp_foot =~ s/!back/$back/;} else {$tmp_foot =~ s/.*//;} if ($next <= $m) {$tmp_foot =~ s/!next/$next/;} else {$tmp_foot =~ s/.*//;} $tmp .= $tmp_foot; print "Content-type: text/html\n\n"; print $tmp; } ### sub tmpread { $flag = ''; open (IN,"$tmpfile") || &error("OPEN ERROR"); while () { if (//) {$flag = 'log';} elsif (//) {$flag = 'foot';} elsif ($flag eq 'log') {$tmp_log .= $_;} elsif ($flag eq 'foot') {$tmp_foot .= $_;} else {$tmp .= $_;} } close IN; } ### sub bbs_log { $data = $tmp_log; $data =~ s/!sub/$sub/; $data =~ s/!name/$name/; $data =~ s/!year/$year/; $data =~ s/!mon/$mon/; $data =~ s/!day/$mday/; $data =~ s/!week/$week[$wday]/; $data =~ s/!hour/$hour/; $data =~ s/!min/$min/; if ($hp) {$data =~ s/!hp/$hp/;} else {$data =~ s/.*?//;} if ($mail) {$data =~ s/!mail/$mail/;} else {$data =~ s/.*?//;} $com =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+)/$1$2<\/a>/g; $data =~ s/!com/$com/; } ### sub newwrt { if (!$in{'name'}) {&error("名前を入力して下さい");} if (!$in{'com'}) {&error("内容を入力して下さい");} $wcom = "$in{'name'}$in{'sub'}$in{'com'}"; open (IN,"$wordfile") || &error("OPEN ERROR"); @deny = split(/
/,); close IN; $flag = 0; foreach (@deny) {if ($_ && 0 <= index($wcom,$_)) {$flag = 1; last;}} if ($flag) {&error("投稿できません");} if ($wcom !~ /(\x82[\x9F-\xF2])|(\x83[\x40-\x96])/) {&error;} $in{'hp'} =~ s/^http\:\/\///; ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime; $year += 1900; $mon++; $min = sprintf("%02d",$min); &lock; open (IN, "$bbsfile") || &error("OPEN ERROR"); @new = ; close IN; while ($logmax <= @new) {pop(@new);} ($no) = split(/<>/,$new[0]); $no++; unshift(@new,"$no<>$year<>$mon<>$mday<>$wday<>$hour<>$min<>$in{'name'}<>$in{'mail'}<>$in{'hp'}<>$in{'sub'}<>$in{'com'}<>\n"); open (OUT, ">$bbsfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; &setcook; print "Location: $script\n\n"; exit; } ### sub admin { &header; $inpass = $in{'pass'}; if ($inpass eq '') { print "

\n"; $wrt = $in{'wrt'}; if ($in{'word'}) {&dword;} elsif ($in{'set'}) {&setup;} else {&deldsp;} print "\n"; } ### sub deldsp { if ($wrt) { &lock; open (IN, "$bbsfile") || &error("OPEN ERROR"); while () { ($no) = split(/<>/); if (!$in{"del$no"}) {push(@new,$_);} } close IN; open (OUT, ">$bbsfile") || &error("OPEN ERROR"); print OUT @new; close OUT; &unlock; } print "「削除」にチェックを入れ、「実行する」を押して下さい。\n"; print "

\n"; print "\n"; print "\n"; print "

\n"; print "

\n"; $m = -1; open (IN,"$bbsfile") || &error("OPEN ERROR"); while () { $m++; if ($m < $num) {next;} if ($next <= $m) {last;} ($no,$year,$mon,$mday,$wday,$hour,$min,$name,$mail,$hp,$sub,$com) = split(/<>/); $com =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%]+)/$1 $2<\/a>/g; print "\n"; print "

$sub　　$name　　 $year年$mon月$mday日($week[$wday]) $hour：$min

削除

\n"; print "

$com

\n"; } close IN; print "\n"; if (0 <= $back) { print "\n"; } if ($next <= $m) { print "\n"; } print "

\n"; } ### sub dword { if ($wrt) { open (OUT,">$wordfile") || &error("OPEN ERROR"); print OUT $in{'com'}; close OUT; } print "禁止語を１語ずつ改行して入力して下さい。\n"; print "

\n"; print "\n"; print "\n"; print "\n"; print "

\n"; open (IN,"$wordfile") || &error("OPEN ERROR"); $com = ; close IN; $com =~ s/
/\r/g; print "\n"; } ### sub setup { if ($wrt) { if ($in{'newpass'} ne '') {$pass = &crypt($in{'newpass'});} $tmpfile = $in{'tmp'}; $page = $in{'page'}; $logmax = $in{'logmax'}; open (OUT,">$opfile") || &error("OPEN ERROR"); print OUT "$pass<>$tmpfile<>$page<>$logmax"; close OUT; } print "下記に入力後、「設定する」を押して下さい。\n"; print "\n"; } ### sub setcook { my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+60*24*60*60); $ww = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday]; $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon]; $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$ww,$mday,$month,$year+1900,$hour,$min,$sec); $cook = "$in{'name'}<>$in{'mail'}<>$in{'hp'}<>"; print "Set-Cookie: bbs41=$cook; expires=$gmt;\n"; } ### sub getcook { if ($in{'reg'}) { $name = $in{'name'}; $mail = $in{'mail'}; $hp = $in{'hp'}; return; } my($n,$val); foreach (split(/;\s*/,$ENV{'HTTP_COOKIE'})) { ($n,$val) = split(/=/); if ($n eq 'bbs41') {last;} $val = ''; } ($name,$mail,$hp) = split(/<>/,$val); } ### sub lock { $retry = 3; if (-e $lockfile) { $locktime = (stat($lockfile))[9]; if ($locktime < time - 60) {&unlock;} } while (!mkdir($lockfile,0755)) { if (--$retry < 0) {&error("busy!");} sleep(1); } } ### sub unlock {rmdir($lockfile);} ### sub crypt { @salt = ('a' .. 'z','A' .. 'Z','0' .. '9'); srand; $salt = "$salt[int(rand($#salt))]$salt[int(rand($#salt))]"; return crypt($_[0],$salt); } ### sub decrypt { $salt = $_[1] =~ /^\$1\$(.*)\$/ && $1 || substr($_[1],0,2); if (crypt($_[0],$salt) eq $_[1] || crypt($_[0],'$1$' . $salt) eq $_[1]) {return 1;} return 0; } ### sub error { if (!$head) {&header;} print "

ERROR !!

$_[0]\n"; print "

[管理]\n"; exit; }

パスワードを入力して下さい

ERROR !!