#!/usr/local/bin/perl # ↑あなたが加入しているプロバイダの「perl」言語が使用できる # パスを指定します。一般的に「#!/usr/local/bin/perl」で大丈夫 # 何度トライしてもサーバーエラーが出る場合は「perl5」にしてみる #======================================================================================= # CustomBBS Version 98.1 #======================================================================================= #日本語コード変換モジュール require './jcode.pl'; #--------------------------------------- #あなたのホームページのアドレス $homepage = 'http://xgag.hauN.org/diary/latest.html'; #--------------------------------------- #メッセージを格納するデータベースファイル $datafile = 'bbsdata.cgi'; #--------------------------------------- #バックグランドの画像ファイル $bg_gif = ''; #--------------------------------------- #管理者削除モードのパスワード $password = '199771'; #--------------------------------------- #掲示板の名前 $title = 'XGAG BBS'; #タイトルを掲示板に表示 $titlevew = 'yes'; #タイトル画像 $title_gif = ''; #トップ画像 $top_gif = ''; #--------------------------------------- #バックグランドカラー $bg_color = '#FFFFFF'; #テキストの文字色 $text_color = '#000000'; #リンク文字色 $link_color = '#0000FF'; #Vリンク文字色 $vlink_color = '#0000FF'; #入力フォームの背景色 $form_bg_color = 'しない'; #記事テーブルの背景色 $tb_bg_color = 'なし'; #--------------------------------------- #本文文字の大きさ $font_size = 3; #--------------------------------------- #コメント最大記憶数(極端に多くするとパフォーマンスが低下します) $max = 100; #--------------------------------------- #1ページに表示する件数 $pagevew = 15; #--------------------------------------- #クッキーを格納する名前を設定する $CookieName = 'custombbs'; #--------------------------------------- #ホスト名の表示 $hostvew = ''; #ブラウザの表示 $agentvew = ''; #--------------------------------------- #項目名 $user_name = 'Name'; $user_email = 'E-Mail'; $email_check = 'yes'; $user_hpaddr = 'HP'; $user_subject = 'Subject'; #--------------------------------------- #ウィンドウの配置 'left' / 'center' $window = 'center'; #--------------------------------------- #入力フォームの枠の太さ $form_border = '0'; #記事テーブルの枠の太さ $table_border = '0'; #舞閧ニ本文のセパレータ $table_line = ''; #舞閧ニ本文のセパレータの背景色 $tb_line_bg_color = 'なし'; #題名の色 $sub_color = '#000080'; #記事テーブルのサイズ $table_width = 80; #--------------------------------------- #管理者メールアドレス $mailto = 'xgag@hk.ntt.net'; #--------------------------------------- #返信記事を投稿順にする 'yes' / 'no' #投稿順に設定すると速度が低下する $rev = 'no'; #--------------------------------------- #タグの許可 'yes' / 'no' / 'member' $tag_flag = 'no'; #======================================================================================= # 初期設定が必要なのはここまでです。 #======================================================================================= $ENV{'TZ'} = "JST-9"; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year = sprintf("%02d",$year + 1900); $month = sprintf("%02d",$mon + 1); $mday = sprintf("%02d",$mday); $hour = sprintf("%02d",$hour); $min = sprintf("%02d",$min); #日付時刻のフォーマットを整えます $youbi = ('日','月','火','水','木','金','土') [$wday]; $date_now = "$year年$month月$mday日($youbi) $hour時$min分"; $softagent = $ENV{'HTTP_USER_AGENT'}; $softagent =~ s/\,/\./g; $hosei = 1; if ($softagent =~ /Mozilla\/4/i && $softagent !~ /compatible/i) { $hosei = 0.8; } $textwidth = 70; if ($softagent =~ /MSIE\ 3/i) { $textwidth = $textwidth * 1.5; } $hostaddr = &domain_name; if ($hostchange eq 'yes' && $hostaddr eq '') { $hostaddr = 'on the Internet'; } if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'}); } else { $QUERY_DATA = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$QUERY_DATA); 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//>/g; $value =~ s/\n//g; $value =~ s/\,/,/g; &jcode'convert(*value,'sjis'); $QUERY{$name} = $value; } if ($window ne 'center') { $table_width = 100; } if ($tb_bg_color eq 'なし') { $tb_bg_color = ''; } else { $tb_bg_color = "bgcolor=$tb_bg_color"; } if ($tb_line_bg_color eq 'なし') { $tb_line_bg_color = $tb_bg_color; } else { $tb_line_bg_color = "bgcolor=$tb_line_bg_color"; } &cookie_read; if (!open(NOTE,"$datafile")) { &error(bad_file); } @DATA = ; close(NOTE); #押されたボタンや、呼び出しに対しての分岐 if ($QUERY{'password'} eq $password) { &deletemode; } elsif ($QUERY{'action'} eq 'comment') { &com_html; } elsif ($QUERY{'action'} eq 'delete') { &delete; } elsif ($QUERY{'action'} eq 'regist') { ®ist; } &html; exit; #======================================================================================= sub html_head { print "Content-type: text/html\n\n"; print "" . $title . "\n"; print "\n"; } #======================================================================================= sub comment_form { if ($window eq 'center') { print "
\n"; } if ($top_gif ne '') { print "
\n"; } print "
\n"; print "\n"; print "\n"; if ($form_bg_color eq 'しない') { $form_bg_color = ''; } else { $form_bg_color = "bgcolor=$form_bg_color"; } print "
\n"; if ($titlevew eq 'yes') { print "$title
\n"; } if ($title_gif ne '') { print "\n"; } print "
\n"; print "\n"; print "\n"; print ""; if ($user_hpaddr ne '') { print "\n"; } if ($user_subject ne '') { print "\n"; } print "
$user_name:
$user_email:
$user_hpaddr:
$user_subject:
\n"; print "
\n"; print "\n"; print "
"; print "\n"; print "
\n"; if ($window eq 'center') { print "
\n"; } } #======================================================================================= sub html { foreach $line (@DATA) { ($date,$code,$re,$name,$email,$HPtitle,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line); if ($re < 1) { push(@MATCH,$line); } } $match = @MATCH; &html_head; if ($window eq 'center') { print "
\n"; } &comment_form; &listvew; print "
\n"; print "\n"; print "\n"; print " \n"; print "
\n"; if ($window eq 'center') { print "
\n"; } print "

CustomBBS by Terra

\n"; print "\n"; exit; } #======================================================================================= sub com_html { foreach $line (@DATA) { ($date,$code,$re,$name,$email,$HP,$subject,$comment) = split(/\,/,$line); if ($code == $QUERY{'res'}) { push(@MATCH,$line); last; } } &html_head; &comment_form; print "
\n"; print "

この記事への返信です。

\n"; &listvew; print "
\n"; print "\n"; exit; } #======================================================================================= sub cookie_regist { $ENV{'TZ'} = "GMT"; ($c_sec,$c_min,$c_hour,$c_mday,$c_mon,$c_year,$c_wday,$c_yday,$c_isdst) = localtime(time + 30 * 86400); $c_year = sprintf("%02d",$c_year); $c_sec = sprintf("%02d",$c_sec); $c_min = sprintf("%02d",$c_min); $c_hour = sprintf("%02d",$c_hour); $c_mday = sprintf("%02d",$c_mday); $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday') [$c_wday]; $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') [$c_mon]; $date_gmt = "$youbi, $c_mday\-$month\-$c_year $c_hour:$c_min:$c_sec GMT"; $cook = "name\!$QUERY{'name'}\,email\!$QUERY{'email'}\,HP\!$QUERY{'HP'}"; print "Set-Cookie: $CookieName=$cook; expires=$date_gmt\n"; $COOKIE{'name'} = $QUERY{'name'}; $COOKIE{'email'} = $QUERY{'email'}; $COOKIE{'HP'} = $QUERY{'HP'}; } #======================================================================================= sub cookie_read { $cookies = $ENV{'HTTP_COOKIE'}; @pairs = split(/;/,$cookies); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ s/ //g; $DUMMY{$name} = $value; } @pairs = split(/,/,$DUMMY{$CookieName}); foreach $pair (@pairs) { ($name, $value) = split(/\!/, $pair); $COOKIE{$name} = $value; } } #======================================================================================= sub listvew { if ($rev eq 'yes') { @DATA = reverse(@DATA); } if ($QUERY{'pline'} eq '') { $pline = 0; } else { $pline = $QUERY{'pline'}; } $end_data = @MATCH - 1; $page_end = $pline + ($pagevew - 1); if ($page_end >= $end_data) { $page_end = $end_data; } if ($table_border == 0) { print "
\n"; } foreach ($pline .. $page_end) { ($date,$code,$res,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$MATCH[$_]); $comment = &inline_link($comment); $comment =~ s/\r/
/g; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; if ($table_line eq 'yes') { print "
\n"; } else { print "
\n"; } print "$subject\n"; if ($email ne '') { print " " . $name . "\n"; } else { print " $name\n"; } print " さん\n"; if ($HP ne '') { print " HomePage"; } print " $date"; if ($hostvew eq 'yes' && $agentvew ne 'yes') { print " ($host)"; } print "\n"; if ($QUERY{'action'} ne 'comment') { print " "; } if ($agentvew eq 'yes') { print "
"; if ($hostvew eq 'yes') { print " ($host)"; } print " $agent"; } if ($table_line eq 'yes') { print "
\n"; } print "
\n"; print "

$comment

\n"; $i = 1; foreach $line (@DATA) { ($da,$co,$re,$na,$em,$H,$su,$com,$ho,$ag) = split(/\,/,$line); if ($rev eq 'no' && $co <= $code) { last; } if ($code eq $re) { $com =~ s/\r/
/g; if ($i == 1) { $ulflag = 1; print "
"; print "
    \n"; } else { print "
    \n"; } $com = &inline_link($com); print "
  • \n"; #メールアドレスが記入されていればリンクをつける if ($em ne '') { print "" . $na . "\n"; } else { print "" . $na . "\n"; } print " さん\n"; if ($H ne '') { print " HomePage\n"; } print " 投稿日:$da"; if ($hostvew eq 'yes' && $agentvew ne 'yes') { print " ($ho)"; } if ($agentvew eq 'yes') { print "
    "; if ($hostvew eq 'yes') { print " ($ho)"; } print " $ag"; } print "

     
    \n"; print "$com
  • \n"; $i++; } } if ($ulflag == 1) { print "
\n"; } print "
\n"; print "

\n"; if ($table_border == 0) { print "


\n"; } } $next_line = $page_end + 1; if ($page_end ne $end_data) { print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "
\n"; } } #======================================================================================= sub regist { if ($QUERY{'comment'} ne '') { if ($QUERY{'name'} eq '') { &error(bad_name); } if ($email_check eq 'yes' && $QUERY{'email'} eq '') { &error(bad_email); } &cookie_regist; $match = 0; if ($tag_flag eq 'yes') { $match = 1; } elsif ($tag_flag eq 'member') { foreach $line (@TAG_MENBER) { if ($line eq $QUERY{'name'}) { $match = 1; last; } } } if ($match) { $QUERY{'comment'} = &tag_change($QUERY{'comment'}); } $count = @DATA; if ($count >= $max) { pop(@DATA); } if ($count < 1) { $new_code = 1; } else { ($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$DATA[0]); $new_code = $code + 1; } $value = "$date_now\,$new_code\,$QUERY{'res'}\,$QUERY{'name'}\,$QUERY{'email'}\,$QUERY{'HP'}\,$QUERY{'subject'}\,$QUERY{'comment'}\,$hostaddr\,$softagent\n"; unshift(@DATA,$value); if (!open(NOTE,">$datafile")) { &error(bad_file); } print NOTE @DATA; close(NOTE); } $QUERY{'res'} = ''; } #======================================================================================= sub deletemode { $count = @DATA; if ($count < 1) { &html; } &html_head; print "
\n"; print "\n"; print "削除コード:\n"; print "
\n"; print "スペースで区切っていくつでも同時に削除することができます。\n"; print "
\n"; print "
\n"; foreach $line (@DATA) { ($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line); print "\n"; print "\n"; print "\n"; print "\n"; print "
[$code]\n"; print "$subject\n"; print " 投稿者:\n"; if ($email ne '') { print "" . $name . "\n"; } else { print "" . $name . "\n"; } print " 投稿日:" . $date . "
\n"; print "$comment\n"; print "
\n"; print "
\n"; } print "
\n"; print "\n"; print "削除コード:\n"; print " 
\n"; print "スペースで区切っていくつでも同時に削除することができます。\n"; print "
\n"; exit; } #======================================================================================= sub delete { $QUERY{'delcode'} =~ s/ / /g; @CODE = split(/ /,$QUERY{'delcode'}); $keycount = @CODE; #削除する番号が指定されていなければ戻る if ($keycount < 1) { &html; } foreach $line (@DATA) { ($date,$code,$re,$name,$email,$HP,$subject,$comment,$host,$agent) = split(/\,/,$line); $match = 0; foreach $delcode (@CODE) { if ($delcode > 0) { if ($code == $delcode || $re == $delcode) { $match = 1; } } } if ($match == 0) { push (@DUMMY,$line); } } @DATA = @DUMMY; #データベースファイルを上書きする if (!open(DB,">$datafile")) { &error(bad_file); } print DB @DATA; close(DB); } #======================================================================================= sub domain_name { local($addr) = $ENV{'REMOTE_ADDR'}; local($_) = gethostbyaddr(pack("C4",split(/\./,$addr)),2); if ($_ eq '') { $_ = $addr; } $_; } #======================================================================================= sub inline_link { local($_) = $_[0]; $_ =~ s/([^=^\"]|^)((http|ftp):[!#-9A-~]+)/$1ここを押して<\/a>/g; $_ =~ s/([!#-9A-~\-\_]+\@[!#-9A-~\-\_\.]+)/$1<\/a>/g; $_; } #======================================================================================= sub tag_change { local($_) = $_[0]; 1 while s/(.*)(<(img([!-:A-~\s\=]+))>)/$1/i; 1 while s/(.*)(<(font[\s\w\=\#\"\']+)\>(.*)\<\/font\>)/$1<$3>$4<\/font>/i; 1 while s/(.*)(<(b)>(.*)<\/b>)/$1$4<\/b>/i; 1 while s/(.*)(<(i)>(.*)<\/i>)/$1$4<\/i>/i; $_; } #======================================================================================= sub error { $error = $_[0]; if ($error eq 'bad_file') { $msg = 'ファイルのオープン、入出力に失敗しました。'; } elsif ($error eq 'bad_name') { $msg = 'ニックネームが記入されていません。'; } elsif ($error eq 'bad_comment') { $msg = 'コメントが記入されていません。'; } elsif ($error eq 'bad_email') { $msg = 'メールアドレスが不正です。'; } elsif ($error eq 'bad_pass') { $msg = 'パスワードが一致しません。'; } elsif ($error eq 'send_mail') { $msg = 'sendmailをオープンできません。'; } else { $msg = '原因不明のエラーで処理を継続できません。'; } &html_head; print "

 

 

 

ERROR

 

 

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

 

 

\n"; print "$msg

 

 

\n"; print "
\n"; exit; }