$Title_name

#!/usr/bin/perl # -------------------------------------------------------------------- # 読み込みが必要なファイルの指定 # ファイルの位置を変更する場合は正しいパスに書き換えて下さい # -------------------------------------------------------------------- require './jcode.pl'; require './pkcnf.cgi'; # -------------------------------------------------------------------- # Pocket Board Version 0.65Beta # 07/03 2003 # Copyright (C) 1997-2003 CGI Pocket - T.Kitazaki # ---- 利用規定 # ---- このCGIプログラムを利用する場合、以下の事項を厳守して下さい。 # ●このCGIプログラムはフリーソフトですが、著作権は作者が所有します。 # ●このCGIプログラム中の作者ページへのリンク、CGIロゴを外して利用する #　　事は出来ません。 # ●このCGIプログラムを作者に無断で再配布、販売する事を禁止します。 # ●このCGIプログラムの設置運用は、ご自身の自己責任において行っていただ #　　くものとします。 # ●このCGIプログラムを使用した事によるいかなる損害に対しても作者は免責 #　　とさせていただきます。 # ●改造は自由ですが、自己責任で行ってください。 # -------------------------------------------------------------------- # 添付ファイルフラグ $UPFILES = 0; @FILENAME = (); @FILEBODY = (); $Sep = "<<__SEP__>>"; # クッキー関連 $coName = 'imgpocket_users'; $Coexp = &Expires(30); %COOKIE = {}; # 管理パスワード open (PWD, $Adm_pwd); $Password = ; close (PWD); # 設定読み込み open (DAT, $Set_dat); while () { $_ =~ s/(\r|\n)//g; ($a, $b) = split (/\t/, $_); ${$a} = $b; } close (DAT); $d_max_filesize = $Max_filesize; if($Max_filesize >= 1000000) { $d_max_filesize = $Max_filesize / 1000000; $d_max_filesize = $d_max_filesize . 'MB'; } else{ $d_max_filesize = $Max_filesize / 1000; $d_max_filesize = $d_max_filesize . 'KB'; } if($Disp_page eq '') { $Disp_page = 10; } $d_msg_length = int ($Msg_length / 2); $d_name_length = int ($Name_length / 2); $d_title_length = int ($Title_length / 2); #IP/ホスト/プロクシ関係 $IP = $ENV{'REMOTE_ADDR'}; $HOST = &my_gethostbyaddr($IP); $AGENT = $ENV{'HTTP_USER_AGENT'}; $VIA = $ENV{'HTTP_VIA'}; $CONNECTION = $ENV{'HTTP_PROXY_CONNECTION'}; $INFO = $ENV{'HTTP_CACHE_INFO'}; $XFOR = $ENV{'HTTP_X_FORWARDED_FOR'}; $FORWARDED = $ENV{'HTTP_FORWARDED'}; $PROXY = &chk_proxy (); $ym = &get_times(7); $now_date = &get_times(0); $Access_log =~ s/#####YM#####/$ym/; $Char_Set = 'sjis'; if($Char_set eq 'sjis') { $charset = 'Shift_JIS'; } elsif($Char_set eq 'euc') { $charset = 'EUC-JP'; } elsif($Char_set eq 'jis') { $charset = 'ISO-2202-JP'; } srand; &read_form($Char_set); my $act = $IN{'act'}; if(not $act){ $act = "-"; } if($Log_Mode) { open (LOG, ">> $Access_log"); print LOG "[$now_date][$HOST][$IP][$AGENT][$act]\n"; close (LOG); } if($HOST_NAME ne '') { if(! &host_chk() ){ &err("システムエラー","アクセス出来ません"); if($Log_Mode) { open (LOG, ">> $Access_log"); print LOG "[NG_HOST_ACCESS][$now_date][$HOST][$IP][$AGENT][$act]\n"; close (LOG); } exit (); } } if($IN{'act'} eq 'add') { &add; } elsif($IN{'act'} eq 'res') { &res; } elsif($IN{'act'} eq 'rem') { &rem; } elsif($IN{'act'} eq 'rem2') { &rem2; } elsif($IN{'act'} eq 'extview') { &extview; } else { &main; } exit(); # -------------------------------------------------------------------- # 掲示板表示 sub main { my ($logsize, $upfilesize, $cosw); &Get_cookie; $logsize = (-s $Log_file); $logsize = $logsize + (-s $Res_file); @files = glob ("$File_updir\/*"); foreach (@files) { $upfilesize = $upfilesize + (-s $_); } if($logsize >= 1000000) { $logsize = int ($logsize / 1000000); $logsize = $logsize . 'MB'; } elsif($logsize >= 1000) { $logsize = int ($logsize / 1000); $logsize = $logsize . 'KB'; } else{ $logsize = ($logsize / 1000); $logsize = $logsize . 'KB'; } if($upfilesize >= 1000000) { $upfilesize = int ($upfilesize / 1000000); $upfilesize = $upfilesize . 'MB'; } elsif($upfilesize >= 1000) { $upfilesize = int ($upfilesize / 1000); $upfilesize = $upfilesize . 'KB'; } else{ $upfilesize = ($upfilesize / 1000); $upfilesize = $upfilesize . 'KB'; } if($COOKIE{'cosw'} eq 'on') { $cosw = ' checked'; } print "Content-type: text/html\n\n"; print < $Title_name

$Head_disi EOM if($IN{'P'} eq '') { $IN{'P'} = 0; } $start = $IN{'P'} * $Disp_page; $end = $start + ($Disp_page - 1); $next = $IN{'P'}+1; $last = $IN{'P'}-1; $cnt = 0; $nf = 0; open (LOG, $Log_file); while () { $_ =~ s/(\r|\n)//g; if($cnt >= $start && $cnt <= $end) { push (@logs, $_); } elsif($cnt > $end) { $nf = 1; } $cnt++; } close (LOG); &logs(@logs); if($IN{'P'} == 0 && $cnt > $Disp_page) { print < 次のページ>> EOM } elsif($IN{'P'} > 0) { if($nf) { print < <<前のページ | 次のページ>> EOM } else { print < <<前のページ EOM } } print <
Pocket Board Beta
- CGI Pocket -

EOM } sub logs { my (@logs) = @_; my (@log, @res, $ress, @tmp); my $i; open (RES, $Res_file); @ress = ; close (RES); foreach (@logs) { undef @res; @log = split (/\t/,$_); #[記事番号][投稿日時][名前][タイトル][削除パス][ファイル][コメント][IP][HOST] for ($i = 0; $i < @ress; $i++) { $ress[$i] =~ s/(\r|\n)//g; @tmp = split (/\t/, $ress[$i]); if($tmp[0] eq $log[0]) { push (@res, $ress[$i]); $ress[$i] = ''; } } if($log[2] eq '') { $log[2] = $No_name; } if($log[3] eq '') { $log[3] = $No_title; } $log[6] = autolink($log[6]); print < EOM if($log[5] eq '') { # 投稿ファイルなし print < \n"; } else { # 投稿ファイルあり print < \n"; } print <

No $log[0] $log[3] 投稿者 : $log[2] $log[1]
$log[6]
EOM if($IN{'act'} ne 'rem' && @res < $Max_res) { print < EOM } print " \n"; if(@res > 0) { foreach (@res) { @tmp = split (/\t/, $_); $tmp[2] = autolink($tmp[2]); print < $tmp[2] EOM } } print "
EOM foreach (split (/$Sep/, $log[5])) { $byte = (-s "$File_upurl\/$_"); if($byte > 1000000) { $byte = int ($byte / 1000000); $byte = $byte . 'MB'; } elsif($byte > 1000) { $byte = int ($byte / 1000); $byte = $byte . 'KB'; } else{ $byte = ($byte / 1000); $byte = $byte . 'KB'; } print < $_(${byte}) EOM } print <	$log[6]
EOM if($IN{'act'} ne 'rem' && @res < $Max_res) { print < EOM } print " \n"; if(@res > 0) { foreach (@res) { @tmp = split (/\t/, $_); $tmp[2] = autolink($tmp[2]); print < $tmp[2] EOM } } print "

EOM } } # 新規投稿 sub add { if($REF_CHECK) { if(! &ref_chk() ){ &err("システムエラー","アクセス出来ません"); if($Log_Mode) { open (LOG, ">> $Access_log"); print LOG "[NG_REFERE_ACCESS][$now_date][$HOST][$IP][$AGENT][$act]\n"; close (LOG); } exit (); } } if(($UPFILES > 0) || ($IN{'comment'} ne '')) { &proxy_chk; # コメント長の確認 my $d_len = int ((length ($IN{'comment'})) / 2); if($d_len > $d_msg_length) { &err("入力エラー","コメントが長すぎます","全角 $d_msg_length 文字以内としてください"); exit; } # 名前長の確認 $d_len = int ((length ($IN{'namae'})) / 2); if($d_len > $d_name_length) { &err("入力エラー","名前が長すぎます","全角 $d_name_length 文字以内としてください"); exit; } # 題名長の確認 $d_len = int ((length ($IN{'title'})) / 2); if($d_len > $d_title_length) { &err("入力エラー","名前が長すぎます","全角 $d_title_length 文字以内としてください"); exit; } $IN{'comment'} =~ s/&/&/g; $IN{'comment'} =~ s//>/g; $IN{'comment'} =~ s/\r\n/\n/g; $IN{'comment'} =~ s/\r/\n/g; $IN{'comment'} =~ s/\n/
/g; my $encpass = ''; if($IN{'mypass'} ne '') { if($IN{'mypass'} =~ /[^0-9a-zA-Z]/) { &err("入力エラー","パスワードは半角英数字を使用してください"); exit; } if(length($IN{'mypass'}) < 4 || length($IN{'mypass'}) > 8) { &err("入力エラー","パスワードは半角英数字4～8文字を使用してください"); exit; } $encpass = &getpass($IN{'mypass'}); } # 添付ファイルの確認 if($UPFILES > 0) { # 書き込み for ($i = 0; $i < $UPFILES; $i++) { $new_file = $File_updir . '/' . $FILENAME[$i]; if(! open (FILE, "> $new_file")) { &err("システムエラー","アップロードディレクトリに書き込み出来ません"); exit; } binmode (FILE); print FILE $FILEBODY[$i]; close (FILE); } } my ($lognum) = &get_lognum; my ($files) = join ("$Sep",@FILENAME); my ($new_data) = "$lognum\t$now_date\t$IN{'namae'}\t$IN{'title'}\t$encpass\t$files\t$IN{'comment'}\t$IP\t$HOST\n"; open (LOG, $Log_file); @logs = ; close (LOG); if(@logs >= $Max_msg) { @delete = splice (@logs, ($Max_msg-1)); } unshift (@logs, $new_data); if(! open (LOG, "> $Log_file")) { &err("システムエラー","ログファイルに書き込み出来ません"); # ファイル削除 for ($i = 0; $i < $UPFILES; $i++) { unlink ("$File_updir\/$FILENAME[$i]"); } exit; } print LOG @logs; close (LOG); # 削除 foreach $list1 (@delete) { @tmp = split (/\t/, $list1); foreach $list2 (split (/$Sep/, $tmp[5])) { unlink ("$File_updir\/$list2"); } } } if($IN{'cosw'} eq 'on') { my $co_name = &enc_cookie_name($IN{'namae'}); my $setcookies="namae<>$co_name<<>>mypass<>$IN{'mypass'}<<>>cosw<>$IN{'cosw'}"; print "Set-Cookie: $coName=$setcookies; expires=$Coexp\n"; } else { my $setcookies="namae<><<>>mypass<><<>>cosw<>"; print "Set-Cookie: $coName=$setcookies\n"; } print "Location: $Cgi?\n\n"; } # レス投稿 sub res { if($IN{'no'} eq '') { &err("システムエラー","システムデータが取得出来ません"); exit; } $f = 1; open (LOG, $Log_file); while () { $_ =~ s/(\r|\n)//g; @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { $f = 0; last; } } close (LOG); if($f) { &err("システムエラー","対象のデータが見つかりません"); exit; } my $ress = 0; open (RES, $Res_file); while () { $_ =~ s/(\r|\n)//g; @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { $ress++; } } close (RES); if($IN{'res'} ne '' && $ress < $Max_res) { &proxy_chk; # コメント長の確認 if(length ($IN{'res'}) > $Res_length) { $moji = $Res_length / 2; &err("入力エラー","コメントが長すぎます","全角 $moji 文字以内としてください"); exit; } $IN{'res'} =~ s/&/&/g; $IN{'res'} =~ s//>/g; $IN{'res'} =~ s/\r\n/\n/g; $IN{'res'} =~ s/\r/\n/g; $IN{'res'} =~ s/\n/
/g; # レスログ形式 # [記事番号][投稿日時][コメント][IP][HOST] my ($new_data) = "$IN{'no'}\t$now_date\t$IN{'res'}\t$IP\t$HOST\n"; open (RES, ">> $Res_file"); print RES $new_data; close (RES); if($Res_up) { # 対象のログを上げる my (@new_logs); my $mydata = ''; open (LOG, $Log_file); while () { @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { $mydata = $_; } else { push (@new_logs, $_); } } close (LOG); unshift (@new_logs, $mydata); if(! open (LOG, "> $Log_file")) { &err("システムエラー","ログファイルに書き込み出来ません"); exit; } print LOG @new_logs; close (LOG); } } print "Location: $Cgi?\n\n"; } # 削除 sub rem { # 入力チェック if($IN{'no'} eq '' || $IN{'password'} eq '') { &err("入力エラー","番号およびパスワードを正しく入力してください"); exit; } my $f = 1; my $mydata; my (@log); open (LOG, $Log_file); while () { $_ =~ s/(\r|\n)//g; @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { $mydata = $_; $f = 0; last; } } close (LOG); if($f) { &err("システムエラー","入力された記事番号が見つかりません"); exit; } # パスワードチェック @log = split(/\t/,$mydata); $pf = 1; if($Password ne '' && ($Password eq crypt($IN{'password'}, $Password))) { $pf = 0; } if($log[4] ne '' && $pf) { if($log[4] eq crypt($IN{'password'}, $log[4])) { $pf = 0; } } if($pf) { &err("システムエラー","パスワードが一致しないか、パスワードが設定されていません"); exit; } print "Content-type: text/html\n\n"; print < $Title_name

$Head_disi

投稿の削除

次の投稿を削除します。
アップロードされたファイルやレスも全て削除されます。
よろしいですか？

EOM &logs($mydata); print < Pocket Board
- CGI Pocket -

EOM } # 削除実行 sub rem2 { # 入力チェック if($IN{'no'} eq '' || $IN{'password'} eq '') { &err("システムエラー","システムデータが取得出来ません"); exit; } my $f = 1; my (@logs, @res, @tmp, @tmp2); open (LOG, $Log_file); while () { @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { @tmp2 = split (/\t/, $_); $f = 0; } else { push (@logs, $_); } } close (LOG); if($f) { &err("システムエラー","入力された記事番号が見つかりません"); exit; } # パスワードチェック $pf = 1; if($Password ne '' && ($Password eq crypt($IN{'password'}, $Password))) { $pf = 0; } if($tmp2[4] ne '' && $pf) { if($tmp2[4] eq crypt($IN{'password'}, $tmp2[4])) { $pf = 0; } } if($pf) { &err("システムエラー","パスワードが一致しないか、パスワードが設定されていません"); exit; } # レス解析 $rf = 0; open (RES, $Res_file); while () { @tmp = split (/\t/, $_); if($tmp[0] eq $IN{'no'}) { $rf = 1; } else { push (@res, $_); } } close (RES); # ログ書き込み if(! open (LOG, "> $Log_file")) { &err("システムエラー","ログファイルに書き込み出来ません"); exit; } if($rf) { if(! open (RES, "> $Res_file")) { &err("システムエラー","ログファイルに書き込み出来ません"); exit; } } print LOG @logs; print RES @res; close (LOG); close (RES); # 添付ファイル削除 foreach (split (/$Sep/, $tmp2[5])) { unlink ("$File_updir\/$_"); } print "Content-type: text/html\n\n"; print < $Title_name

$Head_disi

Pocket Board
- CGI Pocket -

EOM } # 利用できるファイル sub extview { print "Content-type: text/html\n\n"; print < Error Message

EOM } # 記事番号 sub get_lognum { my (@tmp, @nums,@sort); my $num; open (LOG, $Log_file); while () { $_ =~ s/(\r|\n)//g; @tmp = split (/\t/,$_); push (@nums, "$tmp[0]\n"); } close (LOG); @sort = sort { $a <=> $b } @nums; $num = $sort[$#sort] + 1; return $num; } # -------------------------------------------------------------------- #-- フォームデータ読み込み sub read_form { my ($char_code) = shift; my ($buf, $filename, $disposition, $boundary, $contenttype, $filedata); if(not $char_code) { $char_code = 'sjis'; } $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; $contenttype = $ENV{'CONTENT_TYPE'}; if($ENV{'REQUEST_METHOD'} eq "POST"){ binmode(STDIN); read(STDIN, $buf, $ENV{'CONTENT_LENGTH'}); } else{ $buf = $ENV{'QUERY_STRING'}; } if($contenttype =~ /multipart\//i){ # ファイルアップロード if($ENV{'REQUEST_METHOD'} ne "POST"){ &err ("マルチパートリクエストはリクエストメソ\ッドPOSTでご利用下さい"); exit(); } $contenttype =~ /^multipart\/(.*); boundary=(.*)$/; $disposition = $1; $boundary = $2; $buf =~ s/^--${boundary}(\x0d\x0a|\x0d|\x0a|\n)//; $buf =~ s/(\x0d\x0a|\x0d|\x0a|\n)--${boundary}--(\x0d\x0a|\x0d|\x0a|\n)$//; foreach $filedata (split(/(\x0d\x0a|\x0d|\x0a|\n)--${boundary}(\x0d\x0a|\x0d|\x0a|\n)/,$buf)){ if($filedata =~ s/Content-Disposition: form-data; name=\"([^\"]+)\"; filename=\"([^\"]+)\"(\x0d\x0a|\x0d|\x0a|\n)Content-Type: ([^\x0d\x0a|\x0d|\x0a|\n]+)(\x0d\x0a|\x0d|\x0a|\n)(\x0d\x0a|\x0d|\x0a|\n)//eg){ # アップロードが可能か if($File_upload == 0) { &err ("ファイルアップロードエラー","この掲示板はファイルアップロードは出来ません."); exit(); } $filename =$2; $contenttype =$4; if($filedata eq '') { next; } if(length($filedata) <= 0){ &err ("アップロードエラー","指定されたファイルが見つかりません."); exit(); } # パスの消去 if($filename =~ /(\/|\\)?([^\/|\\]+)$/){ $filename = $2; $filename =~ s/$Sep//g; } # 拡張子チェック if($filename =~ /^(.+)(\.)(.+)$/){ $ofn = $1; $ext = $3; } else { &err("アップロードエラー","拡張子の付いていないファイルはアップロード出来ません."); exit(); } # ファイル名チェック if($ofn =~ /[^a-zA-Z0-9\.\-\_]/) { # &err("アップロードエラー","ファイル名に使えない文字が含まれています.","ファイル名に使用できる文字は半角英数字半角ハイフン(-) 半角アンダースコア(_)です."); # exit(); # ファイル名の変更 my $na = &get_times(100) . sprintf("%.3d", int (rand(999))) . sprintf("%.3d", int (rand(999))); $ofn = $na; $filename = $ofn . '.' . $ext; } #重複ファイル名チェック my $check_file = $File_updir . '/' . $filename; my $f = 1; my $co = 1; while ($f){ if(-e $check_file){ #同一ファイルが存在する。 $filename = $ofn . $co . '.' . $ext; $check_file = $File_updir . '/' . $filename; } else{ $f = 0; } $co++; } my ($ofn2,$ext) = split (/\./,$filename); $check_file = $filename; $f = 1; my $co = 1; foreach (@FILENAME){ if($_ eq $check_file){ #同一ファイルが存在する。 $filename = $ofn2 . $co . '.' . $ext; $check_file = $filename; } else{ $f = 0; } $co++; } # ファイルサイズの確認 if( (length($filedata)) > ($Max_filesize + 1024) ) { &err ("ファイルアップロードエラー","ファイルサイズが大きすぎます","${Max_filesize}バイト以内にして下さい."); exit(); } # 拡張子の確認 if($File_ext ne '') { $f = 1; foreach (split (/,/, $File_ext)) { if($_ eq $ext) { $f = 0; last; } } if($f) { &err ("ファイルアップロードエラー","$ext 拡張子のファイルはアップロード出来ません","アップロード出来るファイルは $File_ext です."); exit (); } } $UPFILES++; push (@FILENAME,$filename); push (@FILEBODY,$filedata); } elsif($filedata =~ s/Content-Disposition: form-data; name="([^"]+)"(\x0d\x0a|\x0d|\x0a)(\x0d\x0a|\x0d|\x0a)//g){ $key = $1; $val = $filedata; $val =~ s/\t//g; &jcode::convert(*key,"$char_code"); &jcode::convert(*val,"$char_code"); $IN{$key} = $val; } } } else{ foreach (split(/&/,$buf)){ ($key, $val) = split(/=/,$_,2); $val =~ tr/+/ /; $key =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/\t//g; &jcode::convert(*key,"$char_code"); &jcode::convert(*val,"$char_code"); $IN{$key} = $val; } } } #- 時間の取得 sub get_times { my $mode = shift; if(not $mode) { $mode = 0; } if($mode =~ /[^0-9]/) { $mode = 0; } my $times = time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$idst) = localtime($times); $mon++; $year += 1900; $mon = sprintf("%.2d",$mon); $mday = sprintf("%.2d",$mday); $hour = sprintf("%.2d",$hour); $min = sprintf("%.2d",$min); $sec = sprintf("%.2d",$sec); my (@wtbl) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); my $youbi = $wtbl[$wday]; if($mode == 0) { # 2000/01/02(Sun) 10:10:10 return ("${year}\/${mon}\/${mday}$${youbi}$ ${hour}:${min}:${sec}"); } elsif($mode == 1) { # 2000/01/02(Sun) 10:10 return ("${year}\/${mon}\/${mday}$${youbi}$ ${hour}:${min}"); } elsif($mode == 2) { # 2000/01/02 10:10:10 return ("${year}\/${mon}\/${mday}\ ${hour}:${min}:${sec}"); } elsif($mode == 3) { # 2000/01/02 10:10 return ("${year}\/${mon}\/${mday}\ ${hour}:${min}"); } elsif($mode == 4) { # 2000/01/01 return ("${year}\/${mon}\/${mday}"); } elsif($mode == 5) { # 20000101101010 return ("${year}${mon}${mday}${hour}${min}${sec}"); } elsif($mode == 6) { # 20000101 return ("${year}${mon}${mday}"); } elsif($mode == 7) { # 200201 return ("${year}${mon}"); } elsif($mode == 8){ # 2000 return ("${year}"); } else { return ($times); } } #-- エラー表示 sub err { my (@msg) = @_; my $msg = join ("
", @msg); print "Content-type: text/html\n\n"; print < Error Message

EOM } #-- NGホストチェック sub host_chk { my ($chk) = 1; foreach (split (/,/, $HOST_NAME)) { if($HOST =~ /$_/ || $IP =~ /$_/) { $chk = 0; last; } } return $chk; } #-- リファラーチェック sub ref_chk { if($ENV{'HTTP_REFERER'} =~ /$Url/) { return 1; } else { return 0; } } #-- プロクシチェック sub chk_proxy { my $code = 0; if($VIA ne '' || $CONNECTION ne '' || $INFO ne '' || $XFOR ne '' || $FORWARDED ne ''){ $code = 2; } if($HOST =~/proxy|cache|^delegate|^dns|^mail|keeper|www|^ns\./i){ $code = 2; } if($AGENT=~ /via|squid|delegate|httpd|proxy|cache/i){ $code = 2; } if($VIA =~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ ){ $code = 1; } if($XFOR =~s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/ ){ $code = 1; } if($FORWARDED =~s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/ ){ $code = 1; } return $code; } # 書き込み時プロクシチェック sub proxy_chk { if($PROXY_CHECK == 2) { if($PROXY > 0) { &err ("エラー","プロクシ規制中です."); if($Log_Mode) { open (LOG, ">> $Access_log"); print LOG "[NG_PROXT_ACCESS][$now_date][$HOST][$IP][$AGENT][$act]\n"; close (LOG); } exit (); } } elsif($PROXY_CHECK == 1) { if($PROXY > 1) { &err ("エラー","プロクシ規制中です."); if($Log_Mode) { open (LOG, ">> $Access_log"); print LOG "[NG_PROXT_ACCESS][$now_date][$HOST][$IP][$AGENT][$act]\n"; close (LOG); } exit (); } } } #-- クッキーの読み込み sub Get_cookie { local ($key, $val); local (@length); foreach (split(/; /,$ENV{'HTTP_COOKIE'})){ ($key,$val) = split(/=/); $TEMP{$key} = $val; } @length = split(/\<\<\>\>/,$TEMP{$coName}); foreach (@length) { ($key, $val) = split(/\<\>/); $COOKIE{$key} = $val; } } #-- クッキー有効期限設定 sub Expires{ local($day) = @_; local(@date); local(@week) = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); local(@month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); @date = gmtime(time + $day * 60 * 60 * 24); $date[5] = $date[5] + 1900; foreach (0..3) { $date[$_] = sprintf("%.2d",$date[$_]); } "$week[$date[6]], $date[3]-$month[$date[4]]-$date[5] $date[2]:$date[1]:$date[0] GMT"; } #-- ホスト名の取得 sub my_gethostbyaddr { my ($ip) = @_; my (@addr) = split(/\./, $ip); my (@list); my($pack) = pack("C4", $addr[0], $addr[1], $addr[2], $addr[3]); (@list) = gethostbyaddr($pack, 2); return $list[0]; } #-- クッキー用の名前変換 sub enc_cookie_name { my ($msg) = @_; $msg =~ s/;/;/g; $msg =~ s/"/"/g; return $msg; } #-- 時間表示変換 sub fdate { my ($date) = @_; if($date =~ /\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d(\+|\-)\d\d/) { $date =~ s/(\d\d\d\d)-(\d\d)-(\d\d) (\d\d:\d\d:\d\d)(\+|\-)\d\d/$1\/$2\/$3 $4/; } return $date; } #-- 自動リンク sub autolink { my ($msg) = @_; $msg =~ s/(http:\/\/|https:\/\/)([a-zA-Z0-9\/\~\-\_\.\?\=\#\@\&\;]+)/\$1$2\<\/a\>/g; return $msg; } # カンマをつける sub comma { my ($i) = @_; 1 while $i =~ s/(.*\d)(\d\d\d)/$1\,$2/g; return ($i); } #-- パスワード変換 sub getpass { my ($pass) = @_; my @tbl = ('A'..'Z', 'a'..'z', '0'..'9', '/'); my $key = $tbl[rand(@tbl)] . $tbl[rand(@tbl)]; $pass = crypt ($pass, $key); return ($pass); } #OWARI