#! c:/perl/bin/perl # # bbbbs.cgi # # 順位予想ＢＢＳ # # 2.009 : 7/4/06 : NGワード検出時に403ヘッダを返すように変更 # 2.008 : 6/3/06 : NGワードを追加 # 2.007 : 6/2/06 : 直接書き込み防止機能を追加 # 2.006 : 5/15/06 : メッセージが=で切れるのを修正 # 2.005 : 10/2/05 : Copyrightにリンクを追加 # 2.004 : 9/25/05 : decodeを修正 # 2.003 : 9/18/05 : コメントを修正 # 2.002 : 7/25/05 : コメントが長くなった場合の順位表示の位置を修正 # 2.001 : 2/21/05 : 管理用セットアップのパスワード認証でまれにミスするバグを修正 # 2.0 : 2/20/05 : 一般公開用に大幅改良 # # $Id: bbbbs.cgi,v 1.15 2006/07/04 18:29:17 Hideki Kanayama Exp $ # Copyright(c) 1998-2006 Hideki Kanayama All Right Reserved # use Time::Local; use CGI qw(:cgi-lib); use CGI::Carp qw(fatalsToBrowser); use File::Basename; $version = "2.009"; $lastupdatedyear = "2006"; #$program = $0; #$program =~ s/^.+[\/\\]([^\/\\]+)$/$1/; #$script = "$program"; $script = basename($0); $setupfile = "bbbbs_setup.pl"; $admindat = "adminpwd.dat"; $lang = 0; #### セットアップ #### # データファイル $datafile = "bbdata.dat"; # ロックファイル #$lockfile = "lockfile.dat"; # バックグラウンド $bgimage_en = 0; $bgimagefile = ''; $bgcolor = 'white'; # 記事のバックグラウンド $tb_bgcolor_en = 1; $tb_bgcolor = 'white'; # 名前欄のバックグラウンド $name_bgcolor_en = 1; $name_bgcolor = '#cccccc'; # タイトル $title = 'プロ野球ペナント予想'; $mblogo = ""; $logo_style = ''; $logo_color = 'black'; $logo_size = '+1'; $logo_face = ''; $logo_sel = 0; # 0:デフォルト、1:テキスト、2:ロゴ、3:スタイルシート $logo_loc=1; # 0:左、1:中、2:右 # 書き込みタイトル $mbwrtitle = '予想書き込み'; $mbwr_logo = ""; $mbwr_style = ''; $mbwr_color = 'black'; $mbwr_size = '+1'; $mbwr_face = ''; $mbwr_sel = 0; # 0:デフォルト、1:テキスト、2:ロゴ、3:スタイルシート $mbwr_loc=1; # 0:左、1:中、2:右 # チーム # <リーグ名>,<色>,<チーム名>,<チーム名>,<チーム名>,..... # <リーグ名>,<色>,<チーム名>,<チーム名>,<チーム名>,..... # ..... $team ='セリーグ,#abcd00,中日,ヤクルト,巨人,阪神,広島,横浜 パリーグ,orange,ソフトバンク,西武,日本ハム,ロッテ,オリックス,楽天 '; # トップへのリンク $top_link_en = 1; # トップリンクタイトル $top_link_title = 'トップへ'; # 戻り先 $top_link = "../bbbbs.html"; # 管理用リンク $setup_en = 1; # リンククリック $link_samewin_en = 1; # 書き込みテキストエリアのサイズ $text_cols=50; $text_rows=8; # 予想締め切り 1:on 0:off $deadline_en = 0; $deadline_year = 2005; $deadline_month = 3; $deadline_day = 25; $deadline_hour = 0; $deadline_min = 0; $deadline_color = 'black'; #スタイルシート 1:on 0:off $style_sheet_en = 0; $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #〜内に挿入できる構文 1:on, 0:off $head_insert_en = 0; $head_insert = ''; # 時間設定 GMTからのオフセット　日本:+9 $offset = 9; $ticket = "qualified"; ###################### if (-e "$setupfile"){ require "$setupfile"; } my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; %in=&postprocess(%in); if (! -e "$admindat"){ if ($in{mode} eq 'wradminpwd'){ &wradminpwd; } else { &setadminpwd; } } if ($tb_bgcolor_en == 1){ $tbbgcolor = "bgcolor=$tb_bgcolor"; } else { $tbbgcolor = ""; } if ($name_bgcolor_en == 1){ $namebgcolor = "bgcolor=$name_bgcolor"; } else { $namebgcolor = ""; } @team_array = split (/[\n\r]+/,$team); $i=0; foreach (@team_array){ chomp; $allarray[$i] = [split(/,/)]; $i++; } $deadline_time = timegm(0,$deadline_min,$deadline_hour,$deadline_day,$deadline_month-1,$deadline_year); $gmt = time; $localtime = $gmt + $offset * 3600; if ($in{mode} eq 'read'){ &bbread; } elsif ($in{mode} eq 'wrform'){ &wrform; } elsif ($in{mode} eq 'write'){ &bbwrite; } elsif ($in{mode} eq 'setup'){ if ($in{pwd} eq ''){ &setadminpwd; } else { &bbsetup; } } elsif ($in{mode} eq 'setup_write'){ &setup_write; } else { &bbread; } sub bbread { &getmbdata; @alldata = reverse(@alldata); &htmlhead("$title"); $titleprint=&titleprint("$title","$mblogo","$logo_style","$logo_color","$logo_size","$logo_face","$logo_sel","$logo_loc"); print "$titleprint\n"; &menulink; if ($deadline_en == 1){ printf("

投稿締め切り：%4d年%02d月%02d日%02d時%02d分
\n",$deadline_year,$deadline_month,$deadline_day,$deadline_hour,$deadline_min); } print "

"; if ($#allarray > 0){ print "

\n"; foreach (0 .. $#allarray){ print "$allarray[$_][0]　\n"; } print "全部　\n"; print "
\n"; } foreach (@alldata){ chomp; ($num,$datecode,$name,$ip,$host,$date,$league,$rank)=split(/,/); @allrank = split(/<>/,$rank); foreach (@allrank){ ($key,$elem)=split(/=/); $rankhash{$key} = $elem; } if (((exists $in{league}) && ($in{league} == $league)) || (!exists $in{league})){ print "

\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "\n"; print ""; print "
投稿者： $name$date
\n"; print "
\n"; print "\n"; print "\n"; foreach $j (2 .. $#{$allarray[$league]}){ $s = $j - 1; print "\n"; print "\n"; print "\n"; print "\n"; } print "
$allarray[$league][0]の予\\想
$s位\n"; print "\n"; $hashkey = "sel_${league}_$j"; if ($rankhash{$hashkey} == 0){ print "予\\想なし\n"; } elsif ($rankhash{$hashkey} == 1){ print "考え中\n"; } else { print "$allarray[$league][$rankhash{$hashkey}]\n"; } print "
\n"; print "		\n"; $com = "comment_$league"; if ($rankhash{$com} ne ''){ if ($link_samewin_en == 1){ $link_target = '_top'; } else { $link_target = '_blank'; } $rankhash{$com} =~ s/(https?:\/\/[\w\.\~\-\/\?\&\+\=\:\@\%\;\#\%\$]*)/$1<\/a>$2/g; print "$rankhash{$com}\n"; } else { print " \n"; } print "

\n"; } } &htmltail; } sub wrform { &check_deadline; &htmlhead("$mbwrtitle"); $titleprint=&titleprint("$mbwrtitle","$mbwr_logo","$mbwr_style","$mbwr_color","$mbwr_size","$mbwr_face","$mbwr_sel","$mbwr_loc"); print "$titleprint\n"; #print "@{$allarray[0]}
\n"; print "

\n"; print "
お名前

\n"; print "\n"; foreach $i (0 .. $#team_array){ print "\n"; print "\n"; print "\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; foreach $s (2 .. $#{$allarray[$i]}){ $rank = $s - 1; print "\n"; print "\n"; print "\n"; print "\n"; } print "
$allarray[$i][0]の予\\想\n"; print "
$rank位\n"; print "\n"; print "\n"; print "
\n"; print "		\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "コメント
\n"; print "
\n"; print "
\n"; print "\n"; print "\n"; print "

\n"; } &wrticket; print "

\n"; print "
\n"; &htmltail; } sub bbwrite { &check_deadline; ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($localtime); @wday_array = ('日','月','火','水','木','金','土'); $date_now = sprintf("%02d年%01d月%01d日(%s)%02d時%02d分",$year+1900,$mon +1,$mday,$wday_array[$wday],$hour,$min); $rmon=$mon+1; $datecode="${year}_${rmon}_${mday}"; if ($in{name} eq "") { &error('名前は必ず書いてください。'); } if ($ENV{REQUEST_METHOD} ne 'POST' or $in{ticket} ne "$ticket") { &error("正規の書き込み方法ではありません。"); } if (! open(RD,"<$datafile")){ $number = 1; } else { &getmbdata; ($number,@dummy)=split(/,/,$alldata[$#alldata]); $number = $number + 1; } $host = $ENV{'REMOTE_HOST'}; $ip = $ENV{'REMOTE_ADDR'}; @sel=(); foreach (keys(%in)){ /^send_(.+)/ && ($league_num = $1); /^sel_(\d+)_(\d+)/ && ($sel->[$1][$2] = "$_=$in{$_}"); /^comment_(\d+)/ && ($comment[$1] = "$_=$in{$_}"); } if ($league_num eq 'all'){ foreach $league_num (0 .. $#{$sel}){ &writefile; $number++; } } else { &writefile; } chmod(0666,"$datafile"); if ($in{name} ne "") { print "Location: $script\n\n"; } } sub writefile { $join1[$league_num] = join('<>',@{$sel->[$league_num]},$comment[$league_num]); if ($join1[$league_num] =~ /\[URL/ ) { &error403("書き込み禁止です。"); } open(FILE,">>$datafile") || &error("$datafileを開けません。"); print FILE "$number,$datecode,$in{name},$ip,$host,$date_now,$league_num,$join1[$league_num]\n"; close(FILE); } sub check_deadline { if ($deadline_en == 1 && $localtime > $deadline_time){ &error("締切時間を過ぎているので投稿できません。
表\\示ページへ"); } } sub bbsetup { &checkadmin; $logo_check[$logo_sel] = "checked"; $mbwr_check[$mbwr_sel] = "checked"; $logo_loc_check[$logo_loc] = "checked"; $mbwr_loc_check[$mbwr_loc] = "checked"; $bgimage_check[$bgimage_en] = "checked"; $tb_bgcolor_check[$tb_bgcolor_en] = "checked"; $name_bgcolor_check[$name_bgcolor_en] = "checked"; $title_check[$title_en] = "checked"; $setup_check[$setup_en] = "checked"; $link_samewin_check[$link_samewin_en] = "checked"; $top_link_check[$top_link_en] = "checked"; $deadline_check[$deadline_en] = "checked"; $style_sheet_check[$style_sheet_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; &htmlhead('管理人セットアップ'); print "
"; print ""; print ""; print < データファイル バックグランド 画像を使う カラー設定にする
画像を使う場合の画像ファイル
カラー設定の場合のカラー番号（白：#ffffff 又は white） 記事のバックグランド 有効 無効
カラー番号（白：#ffffff 又は white） 名前欄のバックグランド 有効 無効
カラー番号（白：#ffffff 又は white） タイトル名
無し
デフォルト<H2></H2>
テキスト color= size= face=
ロゴ画像
スタイルシート
位置： 左 中 右 書き込みタイトル
無し
デフォルト<H2></H2>
テキスト color= size= face=
ロゴ画像
スタイルシート
位置： 左 中 右 リーグ、チーム名 <リーグ名>,<色>,<チーム名>,<チーム名>,<チーム名>,.....
<リーグ名>,<色>,<チーム名>,<チーム名>,<チーム名>,.....
<色>はカラー番号（例：白→white、又は#ffffff）

トップへのリンク 表\\示 非表\\示
リンク名
ＵＲＬ
セットアップリンク表\\示 表\\示 非表\\示 自動リンククリック時 同じウィンドウ 別ウィンドウ 書き込みテキストエリアのサイズ 横：　 縦： 予\\想締め切り 有効にすると締め切り日時以降に投稿できなくなります。
有効 無効
締め切り年 月 日 時 分 スタイルシート 有効 無効

<head>内挿入文 有効 無効
ＨＴＭＬ書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。

時間設定 GMTより時間(日本：+9時間) END print ""; print ""; &htmltail; } sub setup_write { &checkadmin; foreach (keys(%in)){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/,/,/g; $in{$_} =~ s/<//g; } $in{post_title_size} =~ s/ /+/; $in{logo_size} =~ s/ /+/; $in{mbwr_size} =~ s/ /+/; open(SETUP,"> $setupfile"); print SETUP <,<色>,<チーム名>,<チーム名>,<チーム名>,..... # <リーグ名>,<色>,<チーム名>,<チーム名>,<チーム名>,..... # ..... \$team = '$in{team}'; # トップへのリンク \$top_link_en = $in{top_link_en}; # トップリンクタイトル \$top_link_title = '$in{top_link_title}'; # 戻り先 \$top_link = "$in{top_link}"; # 管理用リンク \$setup_en = $in{setup_en}; # リンククリック \$link_samewin_en = $in{link_samewin_en}; # 書き込みテキストエリアのサイズ \$text_cols=$in{text_cols}; \$text_rows=$in{text_rows}; # 予\\想締め切り 1:on 0:off \$deadline_en = $in{deadline_en}; \$deadline_year = $in{deadline_year}; \$deadline_month = $in{deadline_month}; \$deadline_day = $in{deadline_day}; \$deadline_hour = $in{deadline_hour}; \$deadline_min = $in{deadline_min}; #スタイルシート 1:on 0:off \$style_sheet_en = $in{style_sheet_en}; \$style_sheet = '$in{style_sheet}'; #〜内に挿入できる構文 1:on, 0:off \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; # 時間設定 GMTからのオフセット　日本:+9 \$offset = $in{offset}; END close(SETUP); print "Location: $script\n\n"; } sub postprocess { my (%in) = @_; my $key; my $value; while (($key,$value)=each %in){ my $br = "
"; $value =~ s//>/g; $value =~ s/\r\n/$br/g; $value =~ s/\n/$br/g; $value =~ s/\r/$br/g; $value =~ s/,/&\#44;/g; $value =~ s/=/&\#61;/g; $in{"$key"}=$value; } return(%in); } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub setadminpwd { &htmlhead('管理者用パスワードを入力してください'); print "
\n"; if ($in{mode} eq 'setup'){ print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; } else { print "
管理者用パスワードを設定してください。
\n"; print "\n"; print "\n"; print "\n"; } print "
\n"; &htmltail; exit; } sub htmlhead { my ($title) = shift; if ($bgimage_en == 1){ $bgimage = "background=\"$bgimagefile\""; } else { $bgimage = "bgcolor=\"$bgcolor\""; } print "Content-type:text/html\n\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "$title\n"; if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } print "\n"; print "\n"; } sub htmltail { my $script_disp = "bbbbs.cgi"; my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "
bbbbs.cgi_disp Ver. $version
\n"; print "
Copyright(C) 1998-$lastupdatedyear, hidekik.com
\n"; print "\n"; } sub wradminpwd { $passwd = &makecrypt($in{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error('パスワードファイル作成に失敗しました'); } print "Location: $script\n\n"; } sub error { my ($msg) = shift; unlink("$lockfile"); &htmlhead($msg); print "
$msg
\n"; &htmltail; exit; } sub error403 { my ($msg) = shift; unlink("$lockfile"); print $q->header(-status=>'403', -charset=>Shift_JIS); print "\n"; print "
$msg
\n"; &htmltail; exit; } sub checkadmin { if (open(FILE,"< $admindat")){; $filepwd = ; close(FILE); $inpwd = crypt($in{pwd},$filepwd); } else { &error('パスワードファイルが存在しません'); } if ("$inpwd" ne "$filepwd"){ &error('パスワードが違います。'); } } sub titleprint { my ($title,$logo,$style,$color,$size,$face,$sel,$loc)=@_; my @location = ('left','center','right'); if ($sel == 0) { $titleline = "

$title

"; } elsif ($sel == 1){ $titleline = "
$title

"; } elsif ($sel == 2){ $titleline = "
\"$title\"

"; } elsif ($sel == 3){ $titleline = "
$title

"; } elsif ($sel == 4){ $titleline = ""; } return($titleline); } sub getmbdata { if (open(FILE,"< $datafile")){ @alldata=; close(FILE); } } sub menulink { print "
\n"; if ($top_link_en == 1){ print "$top_link_title \n"; } print "書き込み\n"; if ($setup_en == 1){ print " 管理用\n"; } print "
\n"; } sub debug_in { print "Content-type: text/html\n\n"; foreach (keys(%in)){ print "$_ -> $in{$_}
\n"; } } sub wrticket { print "\n"; }