#!/usr/local/bin/perl #****************************************************************************** #resbbs.cgi - Response BBS Ver.1.23 # #Version :1.23 #modified :2001/10/02 #Copyright :The Room #E-Mail :dream@lib.net #URL :http://dream.lib.net/room/ # #これはフリー素材です。 #転載・商用目的の利用の際には、メールをお願いします。 # #****************************************************************************** #1行目のperlのディレクトリ指定は、サーバによって異なります。 #詳しくは、管理者にお聞きください。 #****************************************************************************** #画面設定 # #タイトル $title = "リトル・ドッグ・プレス掲示板"; #BODYタグ $bodytag=''; #ページ上部に表示する題名 $pagetop = '
'; #ホームページURL # 設定しない場合とリンクは表示されません。 #$homeback = "http://dream.lib.net/room/"; #****************************************************************************** #メッセージ欄の色 #題名部分の背景色 $msgcl1 = "#f0f0ff"; #名前部分の背景色 $msgcl2 = "#e0e0ff"; #時間表示部分の背景色 $msgcl3 = "#d0d0ff"; #本文の背景色 $msgcl4 = "#c0c0ff"; #****************************************************************************** #入力欄の色 #名前入力欄の背景色 $entercl1 = "#f0f0ff"; #E-Mail入力欄の背景色 $entercl2 = "#e8e8ff"; #URL入力欄の背景色 $entercl3 = "#e0e0ff"; #題名入力欄の背景色 $entercl4 = "#d8d8ff"; #メッセージ入力欄の背景色 $entercl5 = "#d0d0ff"; #削除キー入力欄の背景色 $entercl6 = "#c8c8ff"; #****************************************************************************** #エラーメッセージ表示の色 #エラー表示の枠の色 $error1="#ffffff"; #エラー表示の枠内の色 $error2="#ffffff"; #****************************************************************************** #スタイルシート設定 # inputは入力するボックス、buttonはSubmitなどのボタンを表します。 # 使用しない場合は、削除してください。 $sheet = < EOD #****************************************************************************** # #マスターパスワード # すべての記事の削除キーに使えます。 $adminpass = "password"; #ログ保存ファイル名 $logfile = "./log.dat"; #親記事のログ保存の最大数 $maxlog = 50; #１ページに表示する最大記事数 $maxpage = 10; #名前入力が無い場合の名前 # 設定しないと名前の入力が必須となります。 $newname = ""; #題名入力が無い場合の題名 # 設定しないと題名の入力が必須となります。 $newsubject = ""; #レスがついた記事を一番上に持ってくるなら1を。 $resmove = 1; # #時刻設定 sub timeset{$timeword = "$month/$day($week) $hour:$min";} # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # #２つの " の間に時刻表示のフォーマットを書きます # #以下の変数を書くと、表示されるときに # #その値が表示されます # # # $year 年 # # $month月 # # $day 日 # # $hour 時 # # $min 分 # # $sec 秒 # # $week 曜日 #時刻表示のゼロ補完の有無 # 10以下を表示するときは 04 のように頭に 0 を追加します。 # この機能を使う場合は 1 を、使わない場合は 0 を。 $spzero[0] = 0;#月の補完 $spzero[1] = 0;#日の補完 $spzero[2] = 0;#時の補完 $spzero[3] = 1;#分の補完 $spzero[4] = 0;#秒の補完 #曜日の設定 # 日〜土の順番です。 @weekday = ("Sun","Mon","Tue","Wed","Thr","Fri","Sat"); #****************************************************************************** #ソースにIP/ホスト名を表示するときは1を。 $ipindicate = 1; #jcode.plの位置 $jcode = './jcode.pl'; #アクセス拒否をするホスト名を入力します。 # #@denyhost = ("anonymizer","cache*.*",……); # このように入力していきます。 # 例のように、ワイルドカードも使用できます。 @denyhost = (); #使用を許可するタグを書きます。 # 全て不許可の場合は、 # @permittag = (); # としてください。 @permittag = ("i","b","font"); #URLの書きこみに自動的にリンクを貼るなら1を。 $autolink = 1; #別ページからの投稿を禁止する場合は1を。 $referercheck = 0; #二重投稿を禁止する場合は1を。 $double = 1; #グリニッジ標準時からのずれ（秒単位） # 初期設定は 32400秒 = 9時間の日本時間設定です。 $areatime = 32400; #****************************************************************************** require $jcode; srand; #データ受け取り $cl = $ENV{"CONTENT_LENGTH"}; if( $cl > 0 ){ read(STDIN, $qs, $cl ); }else{ $qs = $ENV{"QUERY_STRING"}; } @contents = split(/&/,$qs); foreach $i (0 .. $#contents) { local($key,$text)= split(/=/,$contents[$i]); $text =~ s/\+/ /g; $text =~ s/%(..)/pack("c",hex($1))/ge; $text =~ s/\r\n/\n/g; &jcode'convert(*text,'sjis'); $act = $text if $key eq 'act'; $page = $text if $key eq 'page'; $name = $text if $key eq 'name'; $email = $text if $key eq 'email'; $url = $text if $key eq 'url'; $subject = $text if $key eq 'subject'; $delkey = $text if $key eq 'delkey'; $msg = $text if $key eq 'msg'; $pass = $text if $key eq 'pass'; $num = $text if $key eq 'num'; $chdel = $text if $key eq 'chdel'; } #環境変数取得 $ip = $ENV{'REMOTE_ADDR'}; $host = gethostbyaddr(pack("C4", split(/\./, $ip)), 2); $host ||= $ENV{'REMOTE_HOST'}; $host ||= $ip; $referer=$ENV{'HTTP_REFERER'}; $script=$ENV{'SCRIPT_NAME'}; #アクセス拒否チェック foreach (@denyhost){ if ($host =~ /$_/i){ &error("あなたの使用しているホストからのアクセスは禁止されています。"); last; } } #データチェック $page||=0; if (($act eq "write") || ($act eq "reswrite")){ $a1 = $msg; $a1 =~ s/[\r\n\t]//g; $act = "" if $a1 eq ""; } #クッキー取得 for $xx (split(/; */, $ENV{'HTTP_COOKIE'})) { ($chname, $value) = split(/=/, $xx); $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; $cookie{$chname} = $value; } $name||=$cookie{'name'}; $email||=$cookie{'email'}; $url||=$cookie{'url'}; $delkey||=$cookie{'delkey'}; #命令分岐 if ($act eq "delete"){&delete;} elsif ($act eq "res"){&res;} $name||=$newname; $subject||=$newsubject; @log=(); $nextflag = 0; $prevflag = 1 if $page != 0; if (($act eq "write") || ($act eq "reswrite")){ &error("名前を入力してください。") if $name eq ""; &error("題名を入力してください。") if $subject eq ""; &error("別ページからの投稿は禁止されています。") if ($referercheck == 1) && ($referer !~ /$script/i); while(1){if (!(chomp($msg))){last;}} #許可タグ以外を無効にする $msg =~ s/[\t\a]//g; $msg =~ s/&/&/g; $msg =~ s//\a/g; foreach (@permittag){ $msg =~ s/\t(\/?$_)\a/<$1>/ig; $msg =~ s/\t$_ ([^\a]*)\a/<$_ $1>/ig; } $msg =~ s/\t/</g; $msg =~ s/\a/>/g; $msg =~ s/&/&/g; foreach (@permittag){ if (($msg =~ /<$_/i) && ($msg !~ /<\/$_/i)){$msg .="<\/$_>";} } #URLには自動的にリンクを行う if (($msg !~ /$1<\/A>/ig; } $msg =~ s/\n/
/g; $subject =~ s//>/g; if ($url eq "http://"){$url = "";} #ファイル読みこみ open (IO,"+<$logfile"); eval{flock(IO,2)}; if ($act eq "write"){ #親記事書きこみ #最大表示数-1の記事を@y1へ $a3=1; $a2=$a4=0; @y1=(); while (){ @y2=split(/<>/,$_); if ($y2[0] > $a2){$a2=$y2[0];} if ($y2[1] == 0){$a3=$y2[0];$a4++;} if ($a4 < $maxpage){push(@y1,$_);} push(@log,$_); } $a2++; @y2 = split(/<>/,$log[0]); #二重書きこみの禁止 if (($double == 1) && ($msg eq $y2[8])){close(IO);&error("二重投稿は禁止されています。");} #ログ追加 unshift(@log,"$a2<>0<>$name<>$email<>$url<>" . time() . "<>$delkey<>$subject<>$msg<>$ip/$host<>\n"); unshift(@y1,"$a2<>0<>$name<>$email<>$url<>" . time() . "<>$delkey<>$subject<>$msg<>$ip/$host<>\n"); #書きこみ truncate(IO,0); seek(IO,0,0); if ($a4+1 > $maxlog){ foreach(@log){ last if $_ =~ /^$a3<>/i; print IO $_; } }else{ print IO @log; } close(IO); if ($log[$maxpage] ne ""){$nextflag = 1;} @log=@y1; }else{ #レス記事書きこみ $a2=$a3=0; $a4=""; @log1=@log2=@log3=@y1=(); while(){ @y2=split(/<>/,$_); if ($y2[0] > $a3){$a3=$y2[0];$a4=$y2[8];} if ($y2[0] == $num){ $a2=1; } elsif (($y2[1] == 0) && ($a2 == 1)){ $a2=2; } push(@log1,$_) if $a2==0; push(@log2,$_) if $a2==1; push(@log3,$_) if $a2==2; } #二重書きこみの禁止 if (($double == 1) && ($msg eq $a4)){close(IO);&error("二重投稿は禁止されています。");} $a3++; #ログ追加 @y2=split(/<>/,$log2[$#log2]); push(@log2,"$a3<>" . ($y2[1]+1) . "<>$name<>$email<>$url<>" . time() . "<>$delkey<>$subject<>$msg<>$ip/$host<>\n"); #ファイル書きこみ truncate(IO,0); seek(IO,0,0); if ($resmove == 1){ foreach(@log2){print IO $_;push(@y1,$_);} foreach(@log1){print IO $_;push(@y1,$_);} foreach(@log3){print IO $_;push(@y1,$_);} }else{ foreach(@log1){print IO $_;push(@y1,$_);} foreach(@log2){print IO $_;push(@y1,$_);} foreach(@log3){print IO $_;push(@y1,$_);} } close (IO); #表示ログ取得 $a1=-1; for (0 .. $#y1){ @y2=split(/<>/,$log[$_]); $a1++ if $y2[1] == 0; last if $a1 >= $maxpage; if ($a1 >= $maxpage){ push(@log,$log[$_]); } } $a1=$nextflag=0; for(0 .. $#y1){ @y2=split(/<>/,$y1[$_]); $a1++ if $y2[1] == 0; if ($a1 > $maxpage){ $nextflag = 1; last; } push(@log,$y1[$_]); } } }else{ #必要な部分だけログ読み $a1=-1; open (IN,"$logfile"); eval{flock(IN,1)}; while(){ @y2=split(/<>/,$_); $a1++ if $y2[1] == 0; last if $a1 >= ($page+1)*$maxpage; if ($a1 >= $page*$maxpage){ push(@log,$_); } } $a1=""; $a1=; close (IN); if ($a1 ne ""){$nextflag = 1;} } #クッキー書きこみ print "Set-Cookie:name=$name; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; print "Set-Cookie:email=$email; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; print "Set-Cookie:url=$url; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; print "Set-Cookie:delkey=$delkey; expires=Thu, 1-Jan-2030 00:00:00 GMT;\n"; &hphead; #ここでメッセージ入力フォームを表示しています。 # formタグ・inputタグ・textareaタグは基本的には変更しないでください。 # inputタグのsize・textareaタグのcols/rowsは変更してもOKです。 print <
おなまえ： 
E-Mail： 
URL： 
 Subject :  
 メッセージ：  
 削除キー： ※削除キーを設定すると書き込んだ記事を削除できます。
EOD #ここまで if ($homeback ne ""){ print "\n"; } print "

"; $flag = 0; for (0 .. $#log){ last if $log[$_] eq ""; &mesindi($log[$_]); } if ($log[0] ne ""){ print <
EOD } #NEXT/BACKのボタン表示 print ""; if ($prevflag == 1){ $a1 = $page-1; print <
EOD } if ($nextflag == 1){ $a1 = $page+1; print <
EOD } #削除フォーム表示 print <
記事番号： 削除キー：
記事掲載の際に入力した削除キーと記事番号を入力し
削除ボタンを押すと記事を削除できます。
EOD &hpfoot; #****************************************************************************** sub mesindi{ #記事表示 my @y2 = split(/<>/,$_[0]); my $a1; #時間形式 ($sec,$min,$hour,$day,$month,$year,$week) = gmtime($y2[5]+$areatime); $month++; $year += 1900; if (($spzero[4] == 1) && ($sec < 10)){$sec="0$sec";} if (($spzero[3] == 1) && ($min < 10)){$min="0$min";} if (($spzero[2] == 1) && ($hour < 10)){$hour="0$hour";} if (($spzero[1] == 1) && ($month < 10)){$month ="0$month";} if (($spzero[0] == 1) && ($day < 10)){$day ="0$day";} $week=$weekday[$week]; ×et; $a1 = ""; if ($y2[3] ne ""){ $a1 = ""; } if ($y2[4] ne ""){ $a1.= ""; } if ($a1 ne ""){$a1=" $a1";} if ($ipindicate == 1){$y2[8].="\n\n";} if ($y2[1] == 0){ if ($flag == 1){ print "\n\n\n\n
\n"; }else{ $flag= 1; } #ここで親記事を表示します。 #タグが入り組んでいるので、出力されるHTMLをよくご覧ください。 # #☆変数説明☆ # $msgcl1~4 メッセージ背景色（冒頭で設定） # $y2[0] 記事番号 # $y2[2] 投稿者名 # $y2[7] 題名 # $y2[8] 本文 # $a1 メール・ホームページのリンク # $timeword 投稿時間 print <
 [$y2[0]]$y2[7]
$y2[2] $y2[8]
$a1  $timeword 
EOD #ここまで }else{ #レス記事表示 # 変数は親記事と同一です。 print <
 [$y2[0]]$y2[7]
$y2[2] $y2[8]
$a1  $timeword 
EOD } } #***************************************************************************** sub res{ #レス入力 my @log=(); my $a1=0; &hphead; print <
以下の記事にレスをつけます。

EOD open (IN,"$logfile"); eval{flock(IN,1)}; while (){ @y2=split(/<>/,$_); if ($y2[0] == $num){ $a1=1; } elsif (($y2[1] == 0) && ($a1 == 1)){ last; } push(@log,$_) if ($a1); } close (IN); for (0 .. $#log){ last if $log[$_] eq ""; &mesindi($log[$_]); } if ($log[0] ne ""){ print <
EOD } ($a1)=(split(/<>/,$log[0]))[7]; #ここでレス入力フォームを表示しています。 # formタグ・inputタグ・textareaタグは基本的には変更しないでください。 # inputタグのsize・textareaタグのcols/rowsは変更してもOKです。 print <
おなまえ：
  
E-Mail：  
URL：  
 Subject：  
 メッセージ：  
 削除キー： ※削除キーを設定すると書き込んだ記事を削除できます。



EOD #ここまで &hpfoot; } #****************************************************************************** sub delete{ #記事削除 #入力データチェック &error("記事番号を指定してください。") if ($chdel eq "") || ($chdel =~/[a-zA-Z]/); &error("削除キーを入力してください。") if $pass eq ""; #削除 my $flag = 0; my (@y2,@log); open (IO,"+<$logfile"); eval{flock(IO,2)}; while (){ @y2=split(/<>/,$_); if (($flag == 1) && ($y2[1] == 0)){ $flag = 3; } if (($_ =~ /^$chdel<>/) && (($y2[6] eq $pass) || ($pass eq $adminpass))){ if ($y2[1] == 0){ $flag = 1; }else{ $flag = 2; } } if ($flag == 2){$flag = 4;} elsif ($flag == 1){} else{push(@log,$_);} #フラグが2ならばその記事のみ削除。 #フラグが1ならば、1の間ずっと削除 } if ($flag != 0){ truncate(IO,0); seek(IO,0,0); print IO @log; close (IO); if ($flag == 4){ &error("$chdel番の記事を削除しました。"); }else{ &error("$chdel番とそのレス記事を削除しました。"); } }else{ close (IO); &error("削除キーが間違っています。"); } } #****************************************************************************** sub error{ #エラー &hphead; print <



$_[0]






EOD &hpfoot; } #****************************************************************************** sub hphead{ #ヘッダ表示 print "Content-type: text/html; charset=shift_jis\n\n"; print < $title $sheet $bodytag $pagetop EOD } #****************************************************************************** sub hpfoot{ #フッタ表示 # #著作権表示を消すことを禁じます。 print <

EOD exit; } #******************************************************************************