ファイル名: w/w6/warewan_bbs01.cgi

#!/usr/local/bin/perl

require '../jcode.pl';


$datafile = "warewan.memo";
#$cgi_url = 'http://vaio/HP2/power/img_get/warewan_bbs01.cgi';
#http:から、指定しろと説明してた。warewan_bbs01.cgiにしたら、動かなくなった。
$cgi_url = 'http://www2u.biglobe.ne.jp/~k-saka/Reference/up_beat_2/perl/w/w6/warewan_bbs01.cgi';

@wdays = ( "日", "月", "火", "水", "木", "金", "土", "日" );
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);$date = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year + 1900, $mon + 1, $mday, @wdays[$wday], $hour, $min,$sec);
#記事ナンバー指定、時間から、作成
$number = ( "$sec$min$hour" );

if ($ENV{'REQUEST_METHOD'} eq 'GET')
{
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST')
{
#書き込みサイズは、最高200000bytesまでにした。
if ($ENV{'CONTENT_LENGTH'} > 200000)
{ &error("$ENV{'CONTENT_LENGTH'} bytes size");}
read(STDIN, $form, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $form);
}
else
{
&error("METHOD");
}

foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);

$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.|\n)*-->//g;
$value =~ s/\n//g;
$value =~ s/\,//g;
$value =~ s/</</g;
   $value =~ s/>/>/g;
   $value =~ s/"/"/g;
&jcode'convert(*value,'sjis');
$FORM{$name} = $value;
}
#コマンド分岐
if ($FORM{'action'} eq 'OK'){&memo;}#ファイルへ、書き込みルーチンへ
elsif ($FORM{'action'} eq 'res'){&res;}#RES入力画面
elsif ($FORM{'action'} eq 'res_form'){&res_save;}#RESの書き込み
elsif ($FORM{'action'} eq 'delete'){&delete;}#削除のパスワード確認ページ
elsif ($FORM{'action'} eq 'delete_memo'){&deletememo;}#削除実行ルーチン
else {&comment;}#記事紹介ページ
#--------------------HTMLのヘッダー--------------------------------------
sub head {
$Title = 'BBS';
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0" link="#00FFFF" vlink="#0099FF" alink="#FFFF00">';
print "Content-type: text/html\n\n";

print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
}
#--------------------------記事掲載ページ------------------------
sub comment
{
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
$count = @lines;
close(IN);

&head;

print "<center>\n";
print "<font size = +2><i>BBS</i></font><SPACER TYPE=\"HORIZONTAL\" SIZE=\"20\">\n";
#print "<a href=\"../../index.htm\"><font color=\"#C0C0C0\">HOME</font></a>\n";
print "<a href=\"warewan_bbs01.cgi\"><font color=\"#C0C0C0\">リロード</font></a>\n";
#削除アイコン表示のための、パラメーター
print "<a href=\"warewan_bbs01.cgi?action=delete_number&page=true&page_end=$FORM{'page_end'}\"><font color=\"#C0C0C0\">Delete</font></a> 記事 $count件(80件になると40件に削除されます。)\n";
print "<BR><BR>\n";

##############form------------------
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<TABLE>\n";
print "<TR><TD>\n";
print "名前(必須入力項目)<BR><input type=text name=name size=30> \n";
print "</TD><TD>\n";
print "メール (省略可)<BR><input type=text name=mail size=30> \n";
print "</TD></TR>\n";
print "<TR><TD>\n";
print "題名 (省略可)<BR><input type=text name=dai size=30>\n";
print "</TD><TD>\n";
print "削除用パス(省略可)<BR><input type=text name=pass size=30>\n";
print "</TD></TR></TABLE>\n";
print "<BR>画像アドレス(省略可)<BR><input type=text name=img size=70> \n";
print "<BR>\n";
print "<BR>MIDIアドレス(省略可)<BR><input type=text name=url size=70> \n";
print "<BR><BR>コメント(必須入力項目)オートリンク<BR>\n";
print "<textarea name=comment rows=6 cols=70></textarea>\n";
print "<BR>\n";
print "<input type=hidden name=action value=OK>\n";
print "<input type=submit value=OK!>\n";
print "</form>\n";
################=============================================
print "</center>\n";
print "<HR NOSHADE SIZE=3 WIDTH=\"700\" ALIGN=CENTER>\n";
#表示ページの最後の配列番号を、FORMに送り次のページの、配列番号を導き出す
if ( $FORM{'page'} eq 'true' ) {
$page = $FORM{'page_end'};
$page_end = $page+9;
if( $count > $page_end ){
($a,$b) = ($page,$page_end)
} else {($a,$b) = ($page,$count-1) }
} else {
if ( $count >= 10 ){
$page = 0;
$page_end = 9;
($a,$b) = ($page,$page_end); } else {
$page = 0;
$page_end = --$count;
($a,$b) = ($page,$page_end); }
}
#読み込みデーターと、書き込みデーターの名前を、区別のため違えた。
foreach $line (@lines[$a..$b]) {
chop($line);
#レスの配列番号を知る。
$kiji_co++;
if($FORM{'page_end'}){ $kiji_count = ($FORM{'page_end'} + $kiji_co) }
else { $kiji_count = $kiji_co }

($memo_number,$memo_host,$memo_addr,$memo_date,$memo_size,$memo_name,$memo_mail,$memo_dai,$memo_pass,$memo_img,$memo_url,$memo_comment,$memo_res) = split(/,/, $line);
$memo_comment =~ s/\r/<br>/g;
print "<blockquote>\n";
print "<IMG SRC=\"star.gif\" WIDTH=\"17\" HEIGHT=\"21\">\n";
#削除アイコン表示ルーチン
if ($FORM{'action'} eq 'delete_number') {
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<input type=hidden name=action value=delete>\n";
print "<input type=hidden name=delete_number value=$memo_number>\n";
print "<input type=submit value=delete>\n";
#print "number $memo_number\n";
print "</form>\n";
}

if ($memo_res eq 'res'){ print "<B>RES</B><BLOCKQUOTE>\n";}
print "$memo_date\n";
print "<SPACER TYPE=\"HORIZONTAL\" SIZE=\"20\">$memo_size bytes\n";
print "<SPACER TYPE=\"HORIZONTAL\" SIZE=\"20\">題名 $memo_dai\n";
print "<SPACER TYPE=\"HORIZONTAL\" SIZE=\"20\">by \n";
if ($memo_mail ne "") {
print "<a href=mailto:$memo_mail><strong>$memo_name</strong></a>\n";
} else { print "<strong>$memo_name</strong>\n"; }
#############返信ボタン###########
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<input type=hidden name=kiji_count value=$kiji_count>\n";
print "<input type=hidden name=action value=res>\n";
print "<input type=submit value=RES>\n";
print "</form>\n";
#------------------------------------------------
print "<BR>\n";
$memo_comment =~ s/([^=^\"]|^)((http|ftp):[!#-9A-~]+)/$1<a href=$2 target=_blank>ここを押してリンクです。<\/a>/g;
print "$memo_comment\n";
print "<BR><BR>\n";
if ( $memo_img ne ""){
print "<div align=\"center\"><center><IMG SRC=\"$memo_img\"></center></div>\n";
print "<BR><BR>\n";}
if ( $memo_url ne ""){
print "<blockquote><embed src=\"$memo_url\" align=\"baseline\" border=\"0\" width=\"150\" height=\"40\" PANEL=\"0\" AUTOSTART=\"false\" REPEAT=\"true\" TEXT=\"WAREWAN\" SAVE=\"true\"></blockquote>\n";}
#######RES
if ($memo_res eq 'res'){ print "</BLOCKQUOTE>\n";}
print "</blockquote>\n";
print "<HR NOSHADE SIZE=2 WIDTH=\"700\" ALIGN=CENTER>\n";
}
if( $count > $page_end +1 ){
print "<center>\n";
#次のページアイコン、パラメーター
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<input type=hidden name=page value=true>\n";
print "<input type=hidden name=page_end value=$page_end>\n";
print "<input type=submit value=NEXT>\n";
print "</form>\n";
print "</center>\n";
}
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#------------------------------MEMOへの書き込み----------------------------
sub memo
{
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
$count = @lines;
close(IN);
$host = &domain_name($ENV{'REMOTE_ADDR'});
$addr = $ENV{'REMOTE_ADDR'};
$size = $ENV{'CONTENT_LENGTH'};

if ($FORM{'name'} eq "") { &error("name"); }
if ($FORM{'comment'} eq "") { &error("comment"); }
if ($FORM{'dai'} eq "") { $FORM{'dai'} = 'no_title' }
if ($FORM{'pass'} eq "") { $FORM{'pass'} = 'warewan_bbs_gest' }
&url;

$new_value = "$number,$host,$addr,$date,$size,$FORM{'name'},$FORM{'mail'},$FORM{'dai'},$FORM{'pass'},$FORM{'img'},$FORM{'url'},$FORM{'comment'},$FORM{'res'}\n";

#全データー配列の最初に、新しいデーターを付け足した。
unshift (@lines,$new_value);



#80件になると、40件に削除する。
if ($count >80){ @DATA = @lines[0..39]
} else { @DATA = @lines }
&data_save;
&comment;

#print "Location: $cgi_url" . '?' . "\n\n";
}
#-------------------------delete passwordページ--------------------------------
sub delete
{
&head;
print "<center>\n";
print "<BR><BR>\n";
print "<font size = +2><i>BBS_β</i></font>\n";
print "<BR><BR>\n";
print "<HR NOSHADE SIZE=2 WIDTH=\"700\" ALIGN=CENTER>\n";
print "<BR><BR>\n";
print "削除する記事のPASSを、記入してください。\n";
print "<BR><BR>\n";
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<input type=hidden name=action value=delete_memo>\n";
print "password\n";
print "<BR><BR>\n";
print "<input type=password name=password size=20>\n";
print "<BR><BR>\n";
print "<BR><BR>\n";
print "delete_number\n";
print "<BR><BR>\n";
print "<input type=password name=delete_number size=20 value=$FORM{'delete_number'}>\n";
print "<BR><BR>\n";
print "削除 <input type=submit value=OK!>\n";
print "</form>\n";
print "<BR><BR>\n";
print "<HR NOSHADE SIZE=2 WIDTH=\"700\" ALIGN=CENTER>\n";
print "<BR><BR>\n";
print "修正する記事のPASSを、記入してください。\n";
print "<BR><BR>\n";
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
close(IN);

foreach $line (@lines) {
chop($line);
($memo_number,$memo_host,$memo_addr,$memo_date,$memo_size,$memo_name,$memo_mail,$memo_dai,$memo_pass,$memo_img,$memo_url,$memo_comment,$memo_res) = split(/,/, $line);
#$memo_comment =~ s/\r/<br>/g;
if ($FORM{'delete_number'} eq "$memo_number"){
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<input type=hidden name=action value=delete_memo>\n";
print "<input type=hidden name=kakike value=new>\n";
print "<input type=hidden name=number value=$memo_number>\n";
print "<input type=hidden name=host value=$memo_host>\n";
print "<input type=hidden name=addr value=$memo_addr>\n";
print "<input type=hidden name=date value=$memo_date>\n";
print "<input type=hidden name=size value=$memo_size>\n";
print "<input type=hidden name=res value=$memo_res>\n";
print "<TABLE>\n";
print "<TR><TD>\n";
print "名前(必須入力項目)<BR><input type=text name=name size=30 value=$memo_name> \n";
print "</TD><TD>\n";
print "メール (省略可)<BR><input type=text name=mail size=30 value=$memo_mail> \n";
print "</TD></TR>\n";
print "<TR><TD>\n";
print "題名 (省略可)<BR><input type=text name=dai size=30 value=$memo_dai> \n";
print "</TD><TD>\n";
print "削除用パス(省略可)<BR><input type=password name=pass size=30>\n";
print "</TD></TR></TABLE>\n";
print "<BR>画像アドレス(省略可)<BR><input type=text name=img size=70 value=$memo_img> \n";
print "<BR>\n";
print "<BR>MIDIアドレス(省略可)<BR><input type=text name=url size=70 value=$memo_url> \n";
print "<BR><BR>コメント(必須入力項目)オートリンク<BR>\n";
print "<textarea name=comment rows=6 cols=70>$memo_comment</textarea>\n";
print "<BR><BR>\n";
print "password\n";
print "<BR>\n";
print "<input type=password name=password size=20>\n";
print "<BR><BR>\n";
print "delete_number\n";
print "<BR>\n";
print "<input type=password name=delete_number size=20 value=$FORM{'delete_number'}>\n";
print "<BR><BR>\n";
print "修正 <input type=submit value=OK!>\n";
print "</form>\n";
}
}
print "<BR><BR>\n";
print "<a href=\"warewan_bbs01.cgi\">BACK</a>\n";
print "</center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#-------------------------deletememo削除-----------------------------------
sub deletememo
{
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
close(IN);
foreach $line ( @lines ) {
($memo_number,$memo_host,$memo_addr,$memo_date,$memo_size,$memo_name,$memo_mail,$memo_dai,$memo_pass,$memo_img,$memo_url,$memo_comment,$memo_res) = split(/,/, $line);
if (($FORM{'delete_number'} eq "$memo_number") && (($FORM{'password'} eq "$memo_pass" )||($FORM{'password'} eq 'warewanbbs01'))){ $flag =1;
if( $FORM{'kakike'} eq 'new' ){
&url;
$new_value = "$FORM{'number'},$FORM{'host'},$FORM{'$addr'},$FORM{'date'},$FORM{'size'},$FORM{'name'},$FORM{'mail'},$FORM{'dai'},$FORM{'pass'},$FORM{'img'},$FORM{'url'},$FORM{'comment'},$FORM{'res'}\n";
push (@del_lines,$new_value);}
} else {
$del_value = $line;
push (@del_lines,$del_value);}
}
#if (!open(OUT,">warewan.memo")) { &error("open"); }
#print OUT (@del_lines);
#close(OUT);

@DATA = @del_lines;
&data_save;
#どっちが良いか?
&comment;
#print "Location: $cgi_url" . '?' . "\n\n";
}
#--------------------------アドレスチェック------------------------------------
sub url {
if ($FORM{'img'} ne ""){
unless ($FORM{'img'} =~ /([^=^\"]|^)((http|ftp):[!#-9A-~]+)/) { &error("img_URL"); } }
if ($FORM{'url'} ne ""){
unless ($FORM{'url'} =~ /([^=^\"]|^)((http|ftp):[!#-9A-~]+)/) { &error("MIDI_URL"); } }
}
#-----------------domain_name----------------------------------------------
sub domain_name {
  local($addr) = $ENV{'REMOTE_ADDR'};
  local($_) = gethostbyaddr(pack("C4",split(/\./,$addr)),2);
  if ($_ eq '') { $_ = $addr; }
  else {
    if (/.+\.(.+)\.(.+)\.(.+)$/) { $_ = "\*\.$1\.$2\.$3"; }
    elsif (/.+\.(.+)\.(.+)$/) { $_ = "\*\.$1\.$2"; }
    elsif (/.+\.(.+)$/) { $_ = "\*\.$1"; }
    else { $_ = "on the internet"; }
  }
  $_;
}
#------------------------res------------------------------------------
sub res
{
&head;
print "<center>\n";
print "<font size = +2><i>BBS</i></font>\n";
print "<BR>\n";
print "<HR NOSHADE SIZE=2 WIDTH=\"700\" ALIGN=CENTER>\n";
print "<BR>\n";
print "返信入力フォームです。\n";
print "<form action=warewan_bbs01.cgi method=POST>\n";
print "<TABLE>\n";
print "<TR><TD>\n";
print "名前(必須入力項目)<BR><input type=text name=name size=30> \n";
print "</TD><TD>\n";
print "メール (省略可)<BR><input type=text name=mail size=30> \n";
print "</TD></TR>\n";
print "<TR><TD>\n";
print "題名 (省略可)<BR><input type=text name=dai size=30>\n";
print "</TD><TD>\n";
print "削除用パス(省略可)<BR><input type=text name=pass size=30>\n";
print "</TD></TR></TABLE>\n";
print "<BR>画像アドレス(省略可)<BR><input type=text name=img size=70> \n";
print "<BR>\n";
print "<BR>MIDIアドレス(省略可)<BR><input type=text name=url size=70> \n";
print "<BR><BR>コメント(必須入力項目)オートリンク<BR>\n";
print "<textarea name=comment rows=6 cols=70></textarea>\n";
print "<BR>\n";
print "<input type=hidden name=kiji_count value=$FORM{'kiji_count'}>\n";
print "<input type=hidden name=res value=res>\n";
print "<input type=hidden name=action value=res_form>\n";
print "<input type=submit value=OK!>\n";
print "</form>\n";
print "<BR>\n";
print "<a href=\"warewan_bbs01.cgi\">BACK</a>\n";
print "</center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#-----------------------res_save-------------------------------------------
sub res_save
{
if (!open(IN,"warewan.memo")) { &error("open"); }
@lines = <IN>;
close(IN);

$host = &domain_name($ENV{'REMOTE_ADDR'});
$addr = $ENV{'REMOTE_ADDR'};
$size = $ENV{'CONTENT_LENGTH'};

if ($FORM{'name'} eq "") { &error("name"); }
if ($FORM{'comment'} eq "") { &error("comment"); }
if ($FORM{'dai'} eq "") { $FORM{'dai'} = 'no_title' }
if ($FORM{'pass'} eq "") { $FORM{'pass'} = 'warewan_bbs_gest' }
&url;

$res_value = "$number,$host,$addr,$date,$size,$FORM{'name'},$FORM{'mail'},$FORM{'dai'},$FORM{'pass'},$FORM{'img'},$FORM{'url'},$FORM{'comment'},$FORM{'res'}\n";
$kiji_count = $FORM{'kiji_count'};
foreach $line ( @lines ) {
$countkazu++;
if ($countkazu ne $kiji_count){push (@res_lines,$line);}
else {
unshift (@res_lines,$res_value);
unshift (@res_lines,$line); }
}
@DATA = @res_lines;
&data_save;
#&comment;
#リロードしないと、RESを続けられない。リロードの書き方はこれでOKか?
print "Location: $cgi_url" . '?' . "\n\n";
}
#-------------------------エラー設定-----------------------------------
sub error
{
#エラーサブルーチンの引数にて受け取る
&head;
print "<center>\n";
print "<BR><BR><BR>\n";
print "$_[0] エラーです。\n";
print "<BR><BR>\n";
print "<a href=\"warewan_bbs01.cgi\">BACK</a>\n";
print "</center>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;
}
#-------------------------ロック設定----落書きさん----------------------------
sub data_save {
local($tmpfile) = $datafile;
$tmpfile =~ s/(\w+)\.\w+$/$1\.tmp/i;
local($flag) = 0;
#10秒待ッテモ書キ込メナイ場合ハ諦メル
foreach (1 .. 10) {
#竹累忤位Р拔゙存此\拔確認
unless (-f $tmpfile) {
#朦弧Р拔゙槙X敲゙作炊コ築W駿
if (open(TMP,">$tmpfile")) {
print TMP "$datafile TMP File\n";
close(TMP);
#朦玄嘆ル噛ト書キ込ム
if (open(TMP,">$datafile")) {
print TMP @DATA;
close(TMP);
$flag = 1;
#朦ク用竹累忤位Р戲削除駿(朦ク解除)
unlink $tmpfile;
last;
}
}
}
#ロック中ナラ1秒待ツ
sleep(1);
}
$flag;
}