#! /usr/bin/perl # #prei.cgiは、共通して使われるサブルーチン集です。 # #ログデータフォーマット #$title:#$vkey:#$sday:#$oname:#$chat:#$host:#$date:# #$voten:#$name:#$vote:#$chat:#$date:#$host:#$times:#$invalid:#$time:# #$voten:新規投票 #$name:特に意味は無い #$invalid:無効票オプション(1|0) #$time:経過秒数 ############################################################################## sub winit{ #初期設定など #プロバイダによっては、CGI専用のサーバーがあるため。 #特に無ければ、$cgifiledir = $cgidirで良い。 $cgifiledir = 'http://localhost'; #実際にCGIのファイルがある所 $cgidir = 'http://localhost'; #CGIを呼び出すパス $cgichk = '/'; #リファラーチェック用 $orititle = '亜流アンケート'; #メインタイトル $indexpage = 'http://www.jks.is.tsukuba.ac.jp/~akaho/'; #インデックスページ $clistpage = 'http://www.jks.is.tsukuba.ac.jp/~akaho/board/clist.cgi'; #カテゴリリスト $bbscgi = 'http://www.jks.is.tsukuba.ac.jp/~akaho/board/minibbs.cgi'; #付属BBSのURL $bbsname = '管理人室'; #付属BBSの名前 $logdir = 'loglog'; #ログディレクトリ名 $coudir = 'counter'; #カウンタディレクトリ名 $vkey = 'v001'; #チェックキー $daylimit = 7.0; #書き込みの無かった掲示板を削除するまでの最大日数 $aday = 1.0; #書き込み増加日数 $sday = 1.0; #初期日数 $hday = 3.0; #最低日数 $cgi_list = 'list.cgi'; #リストスクリプト名 $cgi_log = 'log.cgi'; #ログスクリプト名 $cgi_view = 'view.cgi'; #管理スクリプト名 $cgi_setc = 'setc.cgi'; #クッキー設定スクリプト名 $cgi_find = 'find.cgi'; #検索スクリプト名 $c_lm = "lm"; #クッキーのキー値 $c_pm = "pm"; $host=$ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'}; #リモートホスト名 $hosta=$ENV{'REMOTE_ADDR'}; #実ＩＰアドレス #$host = gethostbyaddr(pack('C4',split(/\./,$host)),2) if($host eq hosta); #プロキシチェック無し $hosta=$ENV{'HTTP_VIA'} if( $ENV{'HTTP_VIA'}=~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ ); $hosta=$ENV{'HTTP_X_FORWARDED_FOR'} if( $ENV{'HTTP_X_FORWARDED_FOR'}=~s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/ ); $hosta=$ENV{'HTTP_FORWARDED'} if( $ENV{'HTTP_FORWARDED'}=~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ ); $agent = $ENV{'HTTP_USER_AGENT'}; #プラウザ $referer = $ENV{'HTTP_REFERER'}; #リファラー $bodys = ''; $metacode = ''; #文字コード指定 $titlemax = 40; #タイトルの文字数 $namemax = 30; #名前の文字数 $votenmax = 30; #発言タイトル文字数 $votemax = 30; #項目名文字数 $mailtos = ''; # メールアドレス $sendmail = '/usr/bin/sendmail'; # sendmailパス $original = "
オリジナルはゆいぼーど2(Free)
"; $retlink = "リストへ戻る"; #エラーから戻る時のリンク #アクセス排除データ。無条件にアクセスを拒否する @noth = ('localhostn'); }#winit END ################################################# sub jikan{#$dateに時刻を代入します。 my($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst,$youbi); $ENV{'TZ'} = 'JST-9';$times = time; #18時間時差があるなら、$times = time+18*60*60とする。 ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($times); $sec = "0$sec" if ($sec < 10); $min = "0$min" if ($min < 10); $mday = "0$mday" if ($mday < 10); $month++; $youbi = ('日','月','火','水','木','金','土') [$wday]; $date = "$month月$mday日（$youbi）$hour時$min分$sec秒"; }#jikan END ################################################## sub noaxschk{ #アクセス拒否 &nocmp if(&limitchk($host,@noth)); } ################################################## sub limitchk{ #アクセス制限チェック my($hst,$r,@nots); ($hst,@nots) = @_; $r=0; foreach (@nots){ if($hst =~ /$_/i) { $r=1; last; } } return $r; } ################################################## sub get_rooms{ #箱のファイル一覧を得る my(@list); opendir(DIR,"$logdir"); @list = grep(/log/, readdir(DIR)); closedir(DIR); return @list; } ################################################## sub nocmp{ print "Content-type: text/html\n\n"; print <<"_HTML_"; $ortitle $metacode $bodys

アクセスありがとうございます。

残念ながら諸般の事情により終了いたしました。

ご利用ありがとうございました。

$original _HTML_ exit; } ################################################## sub err{ my($error); $error = $_[0]; print "Content-type: text/html\n\n"; print <<"_HTML_"; $ortitle $metacode $bodys

次のエラーが発生しました

$error

$retlink

$original _HTML_ exit; } ################################################## #引数をデコードする共通ルーチン #クッキーが欲しい時は、CGI名を引数に入れる sub decodearg{ my($buffer,$thiscgi,@pairs,%dummy,$name,$value); ($buffer,$thiscgi) = @_; @pairs = split(/&/,$buffer); foreach $pair (@pairs){ ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; &jcode'convert(*value,'sjis'); $value =~ s/:#//g; $value =~ s/\t/ /g; $value =~ s/|//g; $value =~ s//>/g; #タグの無条件禁止 if( $name eq 'chat' ){ $value =~ s/\r/\n/g;$value =~ s/\n\n/\n/g;$value =~ s/\n/
/g; }else{ #コメントでない場合は改行コードを除く $value =~ s/"/"/g; $value =~ s/\r//g;$value =~ s/\n//g; } $FORM{$name} = $value if($name && $value); } @pairs = split(/;\s*/,$ENV{'HTTP_COOKIE'}); #クッキーを読む foreach $pair(@pairs){ ($name,$value) = split(/=/,$pair); $dummy{$name} = $value; } @pairs = split(/,/,$dummy{"$cgidir/$thiscgi"}); foreach $pair (@pairs) { ($name,$value) = split(/:/,$pair); $COOKIE{$name} = $value if($name && $value);; } }#decodearg END ################################################## 1; # RETURN TRUE __END__