package stdio; ;######################################################################### ;# ;# CGI Standard Input Output Library Ver 3.22 ;# ;# Copyright(C)1997-1999 Iwao Wada. ;# Script found at ;# ;# This script written in SHIFT-JIS & LF. ;# ;# - 利用規程 ;# ・著作権は放棄していませんが、配布・転載・改造は自由です。 ;# ・転載・再配布される場合も、必ずコピーライトを明記して下さい。 ;# ・改造版を再配布する場合は、必ずオリジナルも添付して下さい。 ;# ・このライブラリを使用した結果について一切の責任は負いません。 ;# ;# - 機能一覧 ;# ・クッキー処理・日付設定処理・フォームデコード ;# ・ファイル読込み・データ読込み・メール送信 ;# ・検索・アップロード・文字列暗号化 ;# ・暗号照合・ファイルロック・インラインリンク ;# ;# - 関数の仕様書 ;# ・すべては関数となっており、引数と戻り値を持つ。 ;# ・特に明記の無い限り、Perl5の文法は使われていない。 ;# ・引数が<***>となっているものは真偽で引数を指定する。 ;# ・引数が{***}となっているものは省略可能である。 ;# ;######################################################################### ;# ;# * クッキー設定 ;# ;# 引数 : (Cookie Name,Cookies,{Expires},{Domain},{Path},{}) ;# 戻値 : 正常に処理できたならば真 (失敗時は偽) ;# ;#------------------------------------------------------------------------ ;# ;# * クッキー取得 ;# クライアントからクッキーの取得を行う。名前とクッキーは"="で、各値は、 ;# "&"で、値とキーは":"で区切りられているものとする。 ;# ;# 引数 : (Cookie Name) ;# 戻値 : 各クッキーが代入されたハッシュ ;# ;#------------------------------------------------------------------------ ;# ;# * 日付設定処理 ;# ;# 引数 : (日時の表記方法) ;# 戻値 : 現在日時 ;# ;# [日時表記の指定方法(例)] ;# ;# $date = stdio::SetTime('yyyy/mm/dd [ww] hh:mm ss'); ;# ;# 上記のように指定すると、戻り値は 2001/09/12 [日] 14:04 24 のよう ;# な形になる。(1999年9月12日-日曜日14時4分24秒を例にしている) ;# ;# yyyy = 年-西暦4桁表記 (ex.2001) ;# yy = 年-西暦2桁表記 (ex.01) ;# y = 年-西暦1桁表記 (ex.1) ;# yyy = 年-和暦表記 (ex.14) ;# m = 月-数字1桁表記 (ex.9) ;# mm = 月-数字2桁表記 (ex.09) ;# mm2 = 月-英語略表記 (ex.Sep) ;# mm3 = 月-英語完全表記 (ex.September) ;# d = 日-数字1桁表記 (ex.12) ;# dd = 日-数字2桁表記 (ex.12) ;# ww = 曜-漢字表記 (ex.日) ;# ww2 = 曜-英語略表記 (ex.Sun) ;# ww3 = 曜-英語完全表記 (ex.Sunday) ;# h = 時-数字1桁24時間表記 (ex.14|2) ;# hh = 時-数字2桁24時間表記 (ex.14|02) ;# n = 分-数字1桁表記 (ex.4) ;# nn = 分-数字2桁表記 (ex.04) ;# s = 秒-数字1桁表記 (ex.24) ;# ss = 秒-数字2桁表記 (ex.24) ;# ap = 時-AM/PM表記 ;# ap2 = 時-am/pm表記 ;# ap3 = 時-午前/午後表記 ;# (注：apを付けると自動的に hh/h は12時間表記になる) ;# ;#------------------------------------------------------------------------ ;# ;# * デコード処理 ;# リクエストされた内容をデコード、分解する。文字コードは"sjis,jis,euc" ;# のいずれかを指定。指定しない場合は文字コードの変換は行われない。文字 ;# コードの変換には"jcode.pl"を呼び出している必要がある。 ;# ;# 引数 : ({<タグ無効>},{改行コード},{文字コード},{}) ;# 戻値 : 各要素が代入された連想配列 ;# ;#------------------------------------------------------------------------ ;# ;# * ファイル読み込み ;# ;# 引数 : (ファイルのパス,{読出開始行},{読出数},{<行数を返す>}) ;# 戻値 : (<行数>),ファイル要素が代入された配列 (失敗時は偽) ;# ;#------------------------------------------------------------------------ ;# ;# * データ読み込み ;# 各レコードをフィールドごとに区切り、ハッシュに代入。これは各フィール ;# ドが","で区切られている場合のみ使用可能。 ;# ;# 引数 : (読み込むレコード) ;# 戻値 : 各フィールドが代入されたハッシュ ;# ;#------------------------------------------------------------------------ ;# ;# * メール送信 ;# sendmailを使ってメールを送信。ファイルを添付する場合はそのパスを指定 ;# する。この処理は"jcode.pl"を呼び出している必要がある。日本語ヘッダー ;# ならびに添付ファイルのエンコード方式は"Base64"である。 ;# ;# 引数 : (Sendmail,To,Cc,Bcc,From,Reply-To,Subject,本文,{}, ;# {Priority},{添付ファイルのパス..}) ;# 戻値 : 正常に処理できたならば真 (失敗時は偽) ;# ;#------------------------------------------------------------------------ ;# ;# * レコード検索 ;# レコード(配列)から指定された条件で検索し、抽出されたレコードを返す。 ;# 検索条件は、0 = AND、1 = OR、2 = 検索式で指定する。検索式は、"&"と ;# "|"、"!"が使用可能。小括弧()による優先順位の指定も可能である。 ;# ;# 引数 : (キーワード,{検索条件},{曖昧検索},検索対象配列) ;# 戻値 : 抽出されたデータ配列 ;# ;#------------------------------------------------------------------------ ;# ;# * 文字列検索 ;# ;# 引数 : (検索対象文字列,キーワード,{検索条件},{曖昧検索}) ;# 戻値 : キーワードと検索条件を満たすならば真 ;# ;#------------------------------------------------------------------------ ;# ;# * アップロード ;# "multipart/form-data"からデータを取得。書式はフォームデコードと同じで ;# ある。ファイルの場合、戻り値のハッシュで"$_{*.name}"とすると、ファイ ;# ルの名前が取得可能。 ;# ;# 引数 : ({<タグ>},{改行},{文字コード}) ;# 戻値 : 各要素が代入されたハッシュ ;# ;#------------------------------------------------------------------------ ;# ;# * 暗号化処理 ;# crypt関数を使って暗号化する。引数として暗号化する文字列を渡す。暗号化 ;# された文字列が戻り値となる。暗号化できなかった場合は偽を返す。この暗号 ;# 化処理は強度を高めるため二重にしている。 ;# ;# 引数 : (平文); ;# 戻値 : 暗号文(crypt関数が使えない場合は負) ;# ;#------------------------------------------------------------------------ ;# ;# * 暗号照合 ;# 前項によって暗号化された文字列が、入力された文字列かどうかを照合。こ ;# の処理では通常の方法で暗号化された文字列も照合可能。 ;# ;# 引数 : (平文,暗号文) ;# 戻値 : 照合一致した場合は真 ;# ;#------------------------------------------------------------------------ ;# ;# * インラインリンク ;# ;# 引数 : (リンクに変換する文字列) ;# 戻値 : (リンクに変換された文字列) ;# ;#------------------------------------------------------------------------ ;# ;# * ファイル出力 ;# ;# 引数 : (ファイルのパス) ;# 戻値 : 正常に処理できたならば真 ;# ;#------------------------------------------------------------------------ ;# ;# * ロックチェック ;# オープンしようとしているファイルがロックされているかチェックする。 ;# ;# 引数 : (データファイルのパス,<1>) ;# 戻値 : ロックされていないならば真 ;# ;#------------------------------------------------------------------------ ;# ;# * ファイルロック ;# ファイルロック、書き込みを行う。データファイルのディレクトリの属性は ;# 777である必要がある。ロック方法は 0はロックしない、1はopen()関数によ ;# るロック、2はsymlink()関数によるロック。 ;# ;# 引数 : (データファイル,ロック方法,データ) ;# 戻値 : 正常に処理できたならば真(symlink関数が使えない場合は負) ;# ;######################################################################### $version = 3.16; ;# ========================== ;# Set Cookie. ;# ========================== sub SetCookie { return 0 if (!$_[0] || !$_[1]); $expires = $domain = $path = $secure = ''; $cookies = $_[1]; if ($_[2] =~ /[0-9]/g) { @CDATE = gmtime(time + 9 * 3600 + 3600 * 24 * $_[2]); @cweek = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); @cmon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); $cweek = $cweek[$CDATE[6]]; $cmon = $cmon[$CDATE[4]]; $CDATE[5] += 1900; $cyear = $CDATE[5]; $cday = sprintf ("%02d",$CDATE[3]); $chour = sprintf ("%02d",$CDATE[2]); $cmin = sprintf ("%02d",$CDATE[1]); $csec = sprintf ("%02d",$CDATE[0]); $expires = " expires=$cweek, $cday\-$cmon\-$cyear $chour:$cmin:$csec GMT;"; } elsif ($_[2]) { $expires = " expires=$_[2];"; } $domain = " domain=$_[3];" if ($_[3]); $path = " path=$_[4];" if ($_[4]); $secure = ' secure' if ($_[5]); print "Set-Cookie: $_[0]=$cookies;" . $expires . $domain . $path . $secure . "\n"; return 1; } ;# ========================== ;# Get Cookie. ;# ========================== sub GetCookie { %COOKIE = (); foreach (split(/;/, $ENV{'HTTP_COOKIE'})) { ($name, $value) = split(/=/, $_); $name =~ s/ //g; last if ($name eq $_[0]); } foreach (split(/&/,$value)) { ($name, $value) = split(/:/, $_); $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $COOKIE{"$name"} = $value; } return %COOKIE; } ;# ========================== ;# Set day and time. ;# ========================== sub SetTime { local($time) = @_; @DATE = gmtime(time + 9 * 3600); if ($time =~ /yyyy/ ) { $DATE[5] += 1900; $time =~ s/yyyy/$DATE[5]/; } elsif ($time =~ /yyy/ ) { $DATE[5] += 1900; $year = $DATE[5] - 1988; $time =~ s/yyy/$year/; } elsif ($time =~ /yy/ ) { $DATE[5] += 1900; $DATE[5] = substr($DATE[5],2); $time =~ s/yy/$DATE[5]/; } else { $DATE[5] += 1900; $DATE[5] = substr($DATE[5],3); $time =~ s/y/$DATE[5]/; } if ($time =~ /dd/ ) { $day = sprintf ("%02d",$DATE[3]); $time =~ s/dd/$day/; } else { $time =~ s/d/$DATE[3]/; } if ($time =~ /ap2/ ) { if ($DATE[2] - 12 < 0 ) { $ap = 'am'; } elsif ($DATE[2] - 12 == 0) { $DATE[2] = 12; $ap = 'pm'; } else { $DATE[2] -= 12; $ap = 'pm'; } $time =~ s/ap2/$ap/; } elsif ($time =~ /ap3/ ) { if ($DATE[2] - 12 < 0 ) { $ap = '午前'; } elsif ($DATE[2] - 12 == 0) { $DATE[2] = 12; $ap = '午後'; } else { $DATE[2] -= 12; $ap = '午後'; } $time =~ s/ap3/$ap/; } elsif ($time =~ /ap/ ) { if ($DATE[2] - 12 < 0 ) { $ap = 'AM'; } elsif ($DATE[2] - 12 == 0) { $DATE[2] = 12; $ap = 'PM'; } else { $DATE[2] -= 12; $ap = 'PM'; } $time =~ s/ap/$ap/; } if ($time =~ /hh/ ) { $hour = sprintf ("%02d",$DATE[2]); $time =~ s/hh/$hour/; } else { $time =~ s/h/$DATE[2]/; } if ($time =~ /nn/ ) { $min = sprintf ("%02d",$DATE[1]); $time =~ s/nn/$min/; } else { $time =~ s/n/$DATE[1]/; } if ($time =~ /ss/ ) { $sec = sprintf ("%02d",$DATE[0]); $time =~ s/ss/$sec/; } else { $time =~ s/s/$DATE[0]/; } if ($time =~ /ww2/ ) { @week = ('Sun','Mon','Tues','Wed','Thu','Fri','Sat'); $time =~ s/ww2/$week[$DATE[6]]/; } elsif ($time =~ /ww3/ ) { @week = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday'); $time =~ s/ww3/$week[$DATE[6]]/; } else { @week = ('日','月','火','水','木','金','土'); $time =~ s/ww/$week[$DATE[6]]/; } if ($time =~ /mm2/ ) { @mont = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); $time =~ s/mm2/$mont[$DATE[4]]/; } elsif ($time =~ /mm3/ ) { @mont = ('January','Februay','March','April','May','June','July','August','September','October','November','December'); $time =~ s/mm3/$mont[$DATE[4]]/; } elsif ($time =~ /mm/ ) { $mon = sprintf ("%02d",$DATE[4] + 1); $time =~ s/mm/$mon/; } else { $mon = $DATE[4] + 1; $time =~ s/m/$mon/; } return $time; } ;# ========================== ;# Decode font-codes. ;# ========================== sub QueryString { if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'}); } elsif ($_[3]) { return 0; } else { $QUERY_DATA = $ENV{'QUERY_STRING'}; } return decode($QUERY_DATA,$_[0],$_[1],$_[2]); } sub decode { @TMP_DATA = @_; foreach (split(/&/,$TMP_DATA[0])) { ($name, $value) = split(/=/, $_); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; if ($TMP_DATA[3]) { &jcode'convert(*value,$TMP_DATA[3]); } if ($TMP_DATA[1]) { $value =~ s/&/&/g; $value =~ s/"/"/g; $value =~ s//>/g; } $value =~ s/,/,/g; $value =~ s/=/=/g; if ($TMP_DATA[2] == 1) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n/
/g; } elsif ($TMP_DATA[2] == 2) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n//g; } elsif ($TMP_DATA[2] == 3) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; } elsif ($TMP_DATA[2] == 4) { $value =~ s/\r\n/\n/g; $value =~ s/\n/\r/g; } elsif ($TMP_DATA[2] == 5) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n/\r\n/g; } $QUERY{"$name"} = $value; } return %QUERY; } ;# ========================== ;# File Read. ;# ========================== sub ReadFile { return 0 if (!open(FILE,$_[0])); if ($_[1] || $_[2]) { $i = $j = 0; while () { if (!$_[1] || $_[1] <= $j) { if ($_[2] && $_[2] <= $i) { last if (!$_[3]); $i ++; next; } $FILE[$i] = $_; $i ++; } $j ++; } } else { @FILE = ; close(FILE); } if (!$_[3]) { return @FILE; } else { return ($i, @FILE); } } ;# ========================== ;# Data Read. ;# ========================== sub ReadData { local(%DATA) = (); foreach $_ (@_) { ($name, $value) = split (/=/, $_); $DATA{"$name"} = $value; } return %DATA; } ;# ========================== ;# Send Email. ;# ========================== sub SendMail { local($sendmail,$mailto,$mailcc,$mailbc,$from,$reply,$subject,$message,$html,$priority,@attend_file) = @_; return 0 if (!$mailto && !$mailcc && !$mailbc); return 0 if (!open(ML,"| $sendmail -t")); if ($html) { $type = 'html'; } else { $type = 'plain'; } print ML "X-HTTP-REFERER: $ENV{'HTTP_REFERER'}\n"; print ML "X-HTTP-USER-AGENT: $ENV{'HTTP_USER_AGENT'}\n"; print ML "X-REMOTE-ADDR: $ENV{'REMOTE_ADDR'}\n"; print ML "X-Priority: $priority\n" if ($priority > 0 && $priority <= 5); print ML "TO: " . encode($mailto) . "\n"; print ML "CC: " . encode($mailcc) . "\n"; print ML "BCC: " . encode($mailbc) . "\n"; print ML "FROM: " . encode($from) . "\n"; print ML "REPLY-TO: " . encode($reply) . "\n"; print ML "Subject: " . encode($subject) . "\n"; print ML "Content-Transfer-Encoding: 7bit\n"; if (@attend_file) { $bound = '===' . $$ . '==='; print ML "Content-Type: multipart/mixed; boundary=\"$bound\"\n\n"; print ML 'This is multipart message.' . "\n\n"; print ML "--$bound\n"; } print ML "Content-Type: text/$type\; charset=\"ISO-2022-JP\"\n\n"; print ML jis($message) . "\n"; if (@attend_file) { foreach (@attend_file) { print ML "--$bound\n"; if (-e $_) { $openfile = $filename = $_; $filename =~ /([^\/\/\/]+$)/; $filename = $1; print ML "Content-Type: application/octet-stream; name=\"$filename\"\n"; print ML 'Content-Transfer-Encoding: Base64' . "\n"; print ML "Content-Disposition: attachment; filename=\"$filename\"\n\n"; if (open(FILE,"$openfile")) { $filedata .= $_ while(); close(FILE); print ML base64encode($filedata); } print ML "\n"; $filedata = ''; } } print ML "--$bound\--\n"; } close(ML); return 1; } sub encode { local($en) = @_; local($ml) = ''; if ($en =~ /(.*)\s+<([\w-]+@[\w-]+\.[\w-\.]+)>/i) { $en = $1; $ml = $2; } if ($en =~ /[^\w\s\.\-\@\=\!\,\?\%\/\\\|\^\~\+\*\$\%\&\'\"\`\:\;\[\]\{\}\<\>\#]/) { $en = '=?ISO-2022-JP?B?' . base64encode(jis($en)) . '?='; } if ($ml) { return "$en <$ml>"; } else { return $en; } } sub base64encode { local($_) = @_; local($chunk,$result); $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' . 'abcdefghijklmnopqrstuvwxyz' . '0123456789+/'; $base64_pad = '='; $uucode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?| . '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'; $uucode_pad = '`'; $tr_uucode = ' ' . $uucode_alphabet; $tr_uucode =~ s/(\W)/\\$1/g; $tr_base64 = "A".$base64_alphabet; $tr_base64 =~ s/(\W)/\\$1/g; while (s/^((.|\n){45})//) { $chunk = substr(pack("u", $&), $[+1, 60); eval qq{ \$chunk =~ tr|$tr_uucode|$tr_base64|; }; $result .= $chunk . "\n"; } if ($_) { $chunk = substr(pack("u", $_), $[+1, int((length($_)+2)/3)*4 - (45-length($_))%3); eval qq{ \$chunk =~ tr|$tr_uucode|$tr_base64|; }; $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)); } return $result; } sub jis { local($msg) = @_; jcode'convert(*msg, 'jis'); return $msg; } ;# ========================== ;# Keyword Search. ;# ========================== sub SearchRecord { local($keyword,$mhmode,$ignore,@DATAS) = @_; local(@RESULT) = (); foreach (@DATAS) { if (SearchString($_,$keyword,$mhmode,$ignore)) { push(@RESULT,$_); } } return @RESULT; } sub SearchString { if (!$_[3]) { $_[0] =~ tr/[A-Z]/[a-z]/; $_[1] =~ tr/[A-Z]/[a-z]/; } if ($_[2] == 0) { foreach (split(/ /, $_[1])) { return 0 unless (index($_[0],$_) >= 0); } return 1; } elsif ($_[2] == 1) { foreach (split(/ /, $_[1])) { return 1 if (index($_[0],$_) >= 0); } return 0; } else { $i = 0; $seek = ''; @STRING = (); foreach (split(/(&|\|)/, $_[1])) { $STRING[$i] .= $_; $i ++ unless ($_ eq '&' || $_ eq '|') } for ($i = 0; $i <= $#STRING; $i ++) { $key = $STRING[$i]; if ($STRING[$i] =~ /^&|\|/) { $opt = substr($key, 0, 1); $key = substr($key, 1); } $open = $1 if ($key =~ /^($+)/g); $clse = $1 if ($key =~ /($+)$/g); $key =~ s/$//g; $key =~ s/$//g; if ($key =~ /^!/) { $key =~ s/^!//g; $not = 1; } $find = 1 if (index($_[0],$key) >= 0); if ($not) { if ($find) { $find = 0; } else { $find = 1; } } $seek .= $opt . $open . $find . $clse; $find = $not = 0; $opt = $open = $clse = ''; } $seek =~ s/&/*/g; $seek =~ s/\|/+/g; $result = eval $seek; if ($result >= 1) { return 1; } else { return 0; } } } ;# ========================== ;# File Upload. ;# ========================== sub GetFile { @TMP_DATA = @_; $remain = $ENV{'CONTENT_LENGTH'}; binmode(STDIN); while ($remain) { $remain -= sysread(STDIN, $buf, $remain); $datas .= $buf; } while (1) { $header2 = index($datas, "\r\n\r\n", $header1) + 4; @headers = split("\r\n", substr($datas, $header1, $header2 - $header1)); foreach (@headers) { if (!$delimiter) { $delimiter = $_; } elsif (/^Content-Disposition: ([^;]*); name="([^;]*)"; filename="([^;]*)"/i) { $name = $2; $filename = $3; } elsif (/^Content-Disposition: ([^;]*); name="([^;]*)"/i) { $name = $2; } } $header3 = index($datas, "\r\n$delimiter", $header2); $size = $header3 - $header2; $value = substr($datas, $header2, $size); if (!$filename) { if ($TMP_DATA[2]) { &jcode'convert(*value,$TMP_DATA[2]); } if ($TMP_DATA[0]) { $value =~ s/&/&/g; $value =~ s/"/"/g; $value =~ s//>/g; } $value =~ s/,/,/g; $value =~ s/=/=/g; if ($TMP_DATA[1] == 1) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n/
/g; } elsif ($TMP_DATA[1] == 2) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n//g; } elsif ($TMP_DATA[1] == 3) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; } elsif ($TMP_DATA[1] == 4) { $value =~ s/\r\n/\n/g; $value =~ s/\n/\r/g; } elsif ($TMP_DATA[1] == 5) { $value =~ s/\r\n/\n/g; $value =~ s/\r/\n/g; $value =~ s/\n/\r\n/g; } } $QUERY{"$name"} = $value; $QUERY{"$name.name"} = $filename; $filename = ''; $header1 = $header3 + length("\r\n$delimiter"); if (substr($datas, $header1, 4) eq "--\r\n") { last; } else { $header1 += 2; if ($i++ > 32) { last; } next; } } return %QUERY; } ;# ========================== ;# Coding. ;# ========================== sub CryptString { $salt = substr($_[0],-1,1) . substr($_[0],0,1); return -1 if (!eval { $pass = crypt($_[0],$salt); }); if ($pass =~ /^\$1\$/) { $salt1 = 5; } else { $salt1 = 3; } $pass = substr($pass,$salt1); @TIME = localtime(time); @RAND = ('0'..'9','A'..'Z','a'..'z','.','/'); $salt = $RAND[($TIME[0] + $TIME[1] * 60 + $TIME[2] * 60 * 60) % scalar(@RAND)]; $salt .= $RAND[(time | $$) % scalar(@RAND)]; return crypt($pass,$salt); } ;# ========================== ;# Decoding. ;# ========================== sub RecryptString { $salt = substr($_[0],-1,1) . substr($_[0],0,1); $pass = crypt($_[0],$salt); if ($pass =~ /^\$1\$/) { $salt1 = 5; $salt2 = 2; } else { $salt1 = 3; $salt2 = 0; } $pass = substr($pass,$salt1); $salt = substr($_[1],$salt2,2); if (crypt($pass,$salt) eq $_[1]) { return 1; } elsif (crypt($_[0],$salt) eq $_[1]) { return 1; } return 0; } ;# ========================== ;# Inline Link. ;# ========================== sub InlineLink { $_[0] =~ s/([^=^\"]|^)((http|https|telnet|ftp|gopher|news):[!#-9A-~]+)/$1$2<\/a>/g; $_[0] =~ s/([!#-9A-~\-\_]+\@[!#-9A-~\-\_\.]+)/$1<\/a>/g; return $_[0]; } ;# ========================== ;# File Output. ;# ========================== sub FileOutput { return 0 if (!open(FILE,$_[0])); ;# binmode(FILE); print $_ while (); close(FILE); return 1; } ;# ========================== ;# Lock check. ;# ========================== sub LockCheck { return 1 if (!$_[1]); for (1 .. 5) { return 1 unless (-e "$_[0].lock"); sleep(1); } return 0; } ;# ========================== ;# File Lock. ;# ========================== sub FileLock { local($datafile,$lock,@DATA) = @_; if (!$lock) { return 0 if (!open(FILE,">$datafile")); print FILE @DATA; close(FILE); return 1; } if (!$$) { $ps = $ENV{'REMOTE_ADDR'}; } else { $ps = $$; } $tempfile = $datafile . $ps . '.tmp'; $lockfile = $datafile . '.lock'; return 0 if (!open(FILE,">$tempfile")); print FILE @DATA; close(FILE); for (1 .. 5) { if ($lock == 2) { if (eval{ symlink(".",$lockfile) }) { if (!rename($tempfile,$datafile)) { sleep(1); next; } unlink($lockfile); return 1; } if ($@) { unlink($tempfile); return -1; } } else { unless (-e $lockfile) { if (open(FILE,">$lockfile")) { close(FILE); if (!rename($tempfile,$datafile)) { sleep(1); next; } unlink($lockfile); return 1; } } } sleep(1); } unlink($tempfile) if (-e $tempfile); unlink($lockfile) if (-e $lockfile); return 0; } 1;