package tdllib;
#
######################################################################
###
###
###  CGI辞書システム T-Dictionary Ver.0.92
###     [6/8] 汎用ライブラリ (tdlib.pl)
###                                 (c) 1996-2002 Takahiro Nishida
###                                 http://www.mytools.net/
###
###
######################################################################
#
### 変数設定部 （詳細は上記ページをご覧下さい） ######################

# データディレクトリ（basedir） のパス
$basedir = ".";
# 戻り先ＵＲＬ
$backurl = "http://your.homepage/";
# 管理者メールアドレス
$admin_email = "your\@email.address";
# 漢字コード
$code = "sjis";
# HTMLディレクトリ
$htmldir = "./html";
# CGI URL
$cgiurl = "http://your.homepage/cgi-bin/dictionary";
# HTML URL
$htmlurl = "http://your.homepage/cgi-bin/dictionary/html";




# 時間補正（単位：時間）
$time_fix = 0;
# 新着扱いする日数
$new_date = 60;
# ファイル１つあたりの最大サイズ(KByte)
$MAX_FILE_SIZE = 300;
# 全ファイルの最大サイズ(KByte)
$MAX_FILE_TOTAL_SIZE = 10240;
# ユーザによるファイル登録の可否（0->不可、1->可）
$ENABLE_FILE = 1;
# ユーザによる画像登録の可否（0->不可、1->可）
$ENABLE_IMAGE = 1;
# 単語の下に表示するコメントの最大件数
$MAX_COMMENTS = 5;
# 全コメント表示時の最大件数
$MAX_ALL_COMMENTS = 100;
# クッキーの有効期限（日）
$COOKIE_EXPIRE_TIME = 30;
# クッキーの名前（１サーバに複数入れる場合は換える）
$cookie_name = "tdictionary";

### 変数設定部 （ここまで）###########################################



# MKDIR時のパーミッション指定
$MKDIR_PARMISSION = 0705;
# エラーコード番号を表示するか（1->する、0->しない）
$SHOW_ERROR_CODE = 1;
# エラーの詳細を表示するか（1->する、0->しない）
$SHOW_ERROR_DETAIL = 0;
# crypt用のsalt
$CRYPT_SALT = "My";

require './jcode.pl';
require './cgi-lib.pl';

$verno = "0.92b.03";
$lockfile = "$basedir/lockdir/tb.lock";
$tmpdir = "$basedir/lockdir";

$filedir = "$htmldir/files";
$fileurl = "$htmlurl/files";
$imgdir = "$htmldir/images";
$imgurl = "$htmlurl/images";

$cgi_lib'maxdata = $MAX_FILE_SIZE * 1024;
$cgi_lib'writefiles = $tmpdir;
$cgi_lib'filepre = "tdf";

$datdic = "$basedir/tdddic.txt";
$datgnr = "$basedir/tddgnr.txt";
$datcom = "$basedir/tddcom.txt";
$datlog = "$basedir/tddlog.txt";
$datreg = "$basedir/tddreg.txt";
$datusr = "$basedir/tddusr.txt";
$tpladm = "$basedir/tdtadm.htm";
$tplusr = "$basedir/tdtusr.htm";
$tplcom = "$basedir/tdtcom.htm";





################################### 基礎関数 ###################################

########## 入力の受け取り
sub parseform{
	&ReadParse(\%F, \%F_CFN, \%F_CT, \%F_SFN);
}

########## 入力の受け取り（file対応）
sub parseformfile{
	local($formname, $dirbase, $dirname, $filename) = @_;
	local($b_dname, $fcname, $fsname, $fpname, $ffname, $fsize);
	
	### ベースディレクトリがなければ即エラー
	(-d $dirbase) || &error("LL-0011", 1, "ベースディレクトリが存在しません：$dirbase");
	
	$fcname = $F_CFN{$formname};
	$fsname = $F_SFN{$formname};
	
	### ディレクトリがなければディレクトリ作成
	$b_dname = $dirbase . "/";
	@dirs = split(/[\\\/]/, $dirname);
	foreach(@dirs){
		$b_dname .= $_;
		(-d $b_dname) || (mkdir($b_dname, $MKDIR_PARMISSION)) || &error("LL-0012", 1, "ディレクトリが作成できません", "ディレクトリ名：$dirname");
		$b_dname .= "/";
	}
	
	### 登録時のファイル名（パスなし）
	@bufs = split(/[\\\/]/, $fcname);
	$ffname = $bufs[$#bufs];
	### ファイル名が指定されていなかったらそれをファイル名に
	($filename) || ($filename = $ffname);
	# 格納フルパスファイル名
	$fpname = "$b_dname$filename";
	
	### リネーム
	rename($fsname, $fpname) || &error("LL-0013", 1, "ファイル名を変更できません", "$fsname → $fpname");
	### ファイルサイズ（小数点２桁）
	$fsize = -s $fpname;
	$fsize = sprintf("%03d", int($fsize * 100 / 1024));
	substr($fsize, -2, 0) = ".";
	
#	   &tdllib'error("EX-0000", 0, "FSNAME:$fsname, FPNAME:$fpname, FFNAME:$ffname, FSIZE:$fsize");
	
	### 登録時のファイル名を戻す
	($ffname, $fsize);
}



########## 入力ファイルの拡張子取得
sub get_formfile_ext{
	local($formname) = @_;
	($ext) = $F_CFN{$formname} =~ m|\.(\w+)$|;
	$ext;
}



########## 画像の存在チェック
sub img_check{
	local($wid) = @_;
	(-f "$imgdir/$wid.gif") && (return "gif");
	(-f "$imgdir/$wid.jpg") && (return "jpg");
	(-f "$imgdir/$wid.png") && (return "png");
	(-f "$imgdir/$wid.GIF") && (return "GIF");
	(-f "$imgdir/$wid.JPG") && (return "JPG");
	(-f "$imgdir/$wid.PNG") && (return "PNG");
	return 0;
}



########## 日本語のデコード
sub decode{
	local($w, $frag) = @_;
	
#	$w =~ tr/+/ /;
#	$w =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$w =~ s/\t//g;
	
	unless($frag){
		$w =~ s/</&LT;/g;
		$w =~ s/>/&GT;/g;
		$w =~ s/"/&#34;/g;
		$w =~ s/'/&#39;/g;
	}
	
#	   $w =~ s/\(/&#40;/g;
#	   $w =~ s/\)/&#41;/g;
#	   $w =~ s/\*/&#42;/g;
#	   $w =~ s/\?/&#63;/g;
#	   $w =~ s/\[/&#91;/g;
#	   $w =~ s/\\/&#92;/g;
#	   $w =~ s/\]/&#93;/g;
#	   $w =~ s/\{/&#123;/g;
#	   $w =~ s/\|/&#124;/g;
#	   $w =~ s/\}/&#125;/g;
	
	$w =~ s/\cM//g;
	$w =~ s/\n{2,}/<P>/g;
	$w =~ s/\n/<BR>/g;
	
	&jcode'convert(*w, $code);
	$w;
}



########## タグを殺す
sub killtag{
	local($w) = @_;
	
	$w =~ s/</&LT;/g;
	$w =~ s/>/&GT;/g;
	$w =~ s/"/&#34;/g;
	$w =~ s/'/&#39;/g;
	
	$w;
}



########## タグを改行に変更
sub tag_to_return{
	local($w) = @_;
	
	$w =~ s/<BR>/\r\n/g;
	$w =~ s/<P>/\r\n\r\n/g;
	
	$w;
}



########## 現在の時刻を得る
sub get_time{
	local($tsec, $format) = @_;
	($tsec) || ($tsec = time() + 60 * 60 * $time_fix);
	local($sec, $min, $hour, $mday, $mon, $year) = localtime($tsec);
	$mon++;
	$year += 1900;
	($format) || return sprintf("%04d/%02d/%02d", $year, $mon, $mday);
	($format == 1) && return sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $mday, $hour, $min, $sec);
	($format == 2) && return sprintf("%04d/%02d/%02d %02d:%02d", $year, $mon, $mday, $hour, $min);
	($format == 3) && return sprintf("%02d/%02d %02d:%02d", $mon, $mday, $hour, $min);
	($format == 4) && return $tsec;
	($format == 5) && return sprintf("%04d/%02d/%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec);
}



########## ファイルを開いて、中身を配列に代入する
sub openfile{
	local ($filename, *bufs, $frag) = @_;
	
	(-f $filename) || ($frag) || &error("LL-0002", 1, "ファイルが存在しません。", "ファイル名：$filename");
	open(FILE, "$filename") || ($frag) || &error("LL-0003", 1, "ファイルを読み込みモードで開くことができません。", "ファイル名：$filename");
	@bufs = <FILE>;
	close(FILE);
	
	(@bufs) ? return(1) : return(0);
}



########## ファイルを更新する
sub updatefile{
	local ($filename, *buf, $frag) = @_;
	
	(-f $filename) || &error("LL-0004", 1, "データファイルが存在しません。", "ファイル名：$filename");
	# フラグあり→追加、なし→更新
	if($frag){
		open(FILE, ">>$filename") || &error("LL-0005", 1, "データファイルを書き込みモードで開くことができません。", "ファイル名：$filename");
	}
	else{
		open(FILE, ">$filename") || &error("LL-0006", 1, "データファイルを書き込みモードで開くことができません。", "ファイル名：$filename");
	}
	print FILE @buf;
	close(FILE);
}



########## ファイルにベタで書き込む
sub writefile{
	local ($filename, $buf, $frag) = @_;
	
	(-f $filename) || &error("LL-0007", 1, "データファイルが存在しません。", "ファイル名：$filename");
	# フラグあり→追加、なし→更新
	if($frag){
		open(FILE, ">>$filename") || &error("LL-0008", 1, "データファイルを書き込みモードで開くことができません。", "ファイル名：$filename");
	}
	else{
		open(FILE, ">$filename") || &error("LL-0009", 1, "データファイルを書き込みモードで開くことができません。", "ファイル名：$filename");
	}
	print FILE $buf;
	close(FILE);
}



########### 一時ファイルを削除
sub cleanup_tmpfile{
	(-d $tmpdir) || &error("LL-0010", 1, "致命的エラー", "一時ディレクトリが存在しません：$tmpdir");
	opendir(DIR, $tmpdir) || &error("LL-0011", 1, "致命的エラー", "一時ディレクトリのファイル一覧を読み込めません：$tmpdir");
	while($file = readdir(DIR)){
		($file =~ /^tdf/) && unlink("$tmpdir/$file");
	}
}



#################### クッキーの処理

########## クッキーを取り出す
sub get_cookie{
	local($cookie_name) = @_;
	local($cookbuf);
	
	# 現在のBOOK向けクッキーがなければ終了
	(($cookbuf) = $ENV{'HTTP_COOKIE'} =~ m|$cookie_name=([^;]+)|) || return;
	
	$cookbuf =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
	
	return $cookbuf;
}



########## クッキーの発行
sub set_cookie{
	local($cookie_name, $value) = @_;
	
	local($expires, $path, $cookie_line);
	
	$expires = &get_time_GMT($^T + 60 * 60 * 24 * $COOKIE_EXPIRE_TIME);
	
	if($ENABLE_COOKIE_PATH){
		($path) = $ENV{'SCRIPT_NAME'} =~ m|^(.+/)[^/]+$|;
		$path = "path=" . $path;
	}
	
	$value =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
	$cookie_line = "Set-Cookie: $cookie_name=$value; expires=$expires; $path\n";
	
	$cookie_line;
}



##### ＧＭＴを得る（クッキー用）
sub get_time_GMT{
	local($tsec) = @_;
	local($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($tsec);
	$wday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday];
	$mon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$mon];
	$year += 1900;
	return sprintf("$wday, %02d-$mon-$year %02d:%02d:%02d GMT", $mday, $hour, $min, $sec);
}





#################### ファイル移動作業関連

# @G_OFN：旧ファイル名、@G_NFN：新ファイル名

###### サーバ上のファイル名を取得
sub get_server_filename{
	local($name) = @_;
	$tdllib'F_SFN{$name};
}
###### 登録時のファイル名（パスなし）を取得
sub get_client_filename{
	local($name) = @_;
	@bufs = split(/[\\\/]/, $tdllib'F_CFN{$name});
	$bufs[$#bufs];
}
###### 指定されたファイルのサイズを取得(KB、小数点以下２桁)
sub get_filesize{
	local($pathname) = @_;
	local($filesize);
	
	$filesize = -s $pathname;
	$filesize = sprintf("%03d", int($fsize * 100 / 1024));
	substr($filesize, -2, 0) = ".";
	
	$filesize;
}
###### renameリストに作成
sub add_filelist{
	local($ofn, $nfn, $flag) = @_;
	
	($ofn) || &error("LL-0021", 1, "致命的エラー", "Original File Name が空");
	($nfn) || &error("LL-0022", 1, "致命的エラー", "New File Name が空");
	
	### フラグがなかったらディレクトリも作成（一番深いとこだけ）
	unless($flag){
		($pathname) = $nfn =~ m|^(.+)[\\\/].+$|;
		push(@G_MFT, "MD");
		push(@G_OFN, "");
		push(@G_NFN, $pathname);
	}
	
	### ファイル作成ログ
	push(@G_MFT, "F");
	push(@G_OFN, $ofn);
	push(@G_NFN, $nfn);
	$rename_success_no = -1;
}
###### 削除用に追加
sub add_filelist_to_delete{
	local($ofn, $flag) = @_;
	&add_filelist($ofn, "$tdllib'tmpdir/tdf." . &make_new_id());
	
	### フラグがなかったらディレクトリも削除（一番深いとこだけ）
	if($flag){
		($pathname) = $ofn =~ m|^(.+)[\\\/].+$|;
		push(@G_MFT, "DD");
		push(@G_OFN, "");
		push(@G_NFN, $pathname);
	}
}
###### ディレクトリ削除
sub add_filelist_to_dir_delete{
	local($odn) = @_;
	push(@G_MFT, "DD");
	push(@G_OFN, "");
	push(@G_NFN, $odn);
}
###### リネームの実行
sub exec_filelist{
	### リストが空なら実行しない
	(@G_OFN) || return;
	### チェック
	(@G_OFN == @G_NFN) || &error("LL-0031", 1, "致命的エラー", "rename filelistの長さが違う");
	foreach(0..$#G_OFN){
		$errorbuf .= "(No.$_) OLD:$G_OFN[$_] -> NEW:$G_NFN[$_]<BR>";
	}
#	   &tdllib'error("LL-9999", 1, "Debug:$rename_success_no", $errorbuf);
	
	### rename作業
	for(0..$#G_OFN){
		if($G_MFT[$_] eq "F"){
			(-f $G_OFN[$_]) || &error("LL-0023", 1, "致命的エラー", "rename元ファイルが見つからない ($ofn -> $nfn)");
			(-f $G_NFN[$_]) && &error("LL-0024", 1, "致命的エラー", "rename先に別のファイルが存在する ($ofn -> $nfn)");
			rename($G_OFN[$_], $G_NFN[$_]) || &error("LL-0034", 1, "致命的エラー", "rename失敗($G_OFN[$_] -> $G_NFN[$_])");
		}
		### ディレクトリ作成と削除（失敗しても無視）
		elsif($G_MFT[$_] eq "MD"){
			mkdir($G_NFN[$_], $MKDIR_PARMISSION);
		}
		elsif($G_MFT[$_] eq "DD"){
			rmdir($G_NFN[$_]);
		}
		$rename_success_no = $_;
	}
}
###### ロールバックの実行
sub rollback_filelist{
	### リストが空なら実行しない
	(@G_NFN) || return;
	### リネームが一件も成功していなかったら実行しない
	($rename_success_no > -1) || return;
	
	### エラー表示用にリスト作成
	$errorbuf  = "Rename successed until No.$rename_success_no.<BR>";
	foreach(0..$#G_OFN){
		$errorbuf .= "(No.$_) OLD:$G_OFN[$_] -> NEW:$G_NFN[$_]<BR>";
	}
	### rename戻し作業（後ろから）
	for($i = $rename_success_no; $i > -1; $i--){
		if($G_MFT[$_] eq "F"){
			rename($G_NFN[$i], $G_OFN[$i]) || &error("LL-0041", 1, "致命的エラー", "rename戻し失敗 (Rename-Back Failed at No.$_)。ファイルの整合性がとれない状態になっている恐れがあります。<P>$errorbuf");
		}
		### ディレクトリ削除と作成（失敗しても無視）
		elsif($G_MFT[$_] eq "MD"){
			rmdir($G_NFN[$_]);
		}
		elsif($G_MFT[$_] eq "DD"){
			mkdir($G_NFN[$_], $MKDIR_PARMISSION);
		}
	}
}




########## システムで一意なＩＤの生成
sub make_new_id {
	local($idate, $ips, $isn);
	
	$idate = sprintf("%010d", &get_time(0, 4)); # 秒時間１０桁
	$ips = sprintf("%02d", $$ % 100); # プロセス番号の下二桁
	$isn = sprintf("%02d", ++$sequence_no); # 実行中で一意な値
	
	return $idate.$ips.$isn;
}



########## コピーライト
sub copyright{
	"
<TABLE ALIGN=\"right\" BORDER=\"1\" CELLPADDING=\"0\" CELLSPACING=\"0\">
<TR><TH BGCOLOR=\"#FFFFCC\">
<A HREF=\"http://www.mytools.net/\" TARGET=\"_top\">
<FONT SIZE=\"2\" COLOR=\"#660000\">Powered by T-Dictionary Ver.$verno</A>
</FONT></TH></TR></TABLE>
	";
}



########## ロック
sub lock{
	$try = 3;
	while(!(mkdir($lockfile, $MKDIR_PARMISSION))){
		(--$try > 0) || &error("LL-0001", 0, "ロック中です。数秒待ってから再度実行してください。");
		sleep(1);
	}
}



########## ロック解除
sub unlock{
	rmdir($lockfile);
}



########## 汎用エラーメッセージ
sub error{
	local($code, $actflg, $msg, $detail) = @_;
	
	### rename戻し（41を許すと永久ループの恐れ）
	($code eq "LL-0041") || &rollback_filelist();
	### 一時ファイルの消去（10と11を許すと永久ループの恐れ）
	($code eq "LL-0010" || $code eq "LL-0011") || &cleanup_tmpfile();
	
	$fmsg[0] = "ブラウザのBackを押して戻ってください。";
	$fmsg[1] = "管理者に連絡してください。";
	
	### 戻るor連絡
	$actmsg = $fmsg[$actflg];
	### コード非表示の場合は隠す
	$code = ($SHOW_ERROR_CODE) ? "<B>$code</B>: " : "";
	### 詳細非表示の場合は隠す
	$detail = ($detail && $SHOW_ERROR_DETAIL) ? "<FONT SIZE=\"2\" COLOR=\"#0000FF\">$detail</FONT><P>" : "";
	
	print "Content-type: text/html\n\n";
	print "
<HTML>
<HEAD><TITLE>T-Dictionary - Error!!</TITLE></HEAD>
<BODY BGCOLOR=\"#FFFFFF\">
<FONT SIZE=\"3\">
<H3>エラー発生</H3>
$code
<FONT COLOR=\"#FF0000\">$msg</FONT><P>
$detail
$actmsg
<HR NOSHADE SIZE=\"1\">
<FONT SIZE=\"2\">
<B>管理者：<A HREF=\"mailto:$admin_email\">$admin_email</A></B><BR>
※ ご一報の際にはサイトのＵＲＬと症状をお書き添え下さいますようお願いします。
</FONT>
";

	print &tdllib'copyright;
	print "</BODY></HTML>";
	
	local(@sts) = lstat($lockfile);
	local($tn) = time();
	
	($code eq "LL-0001") || &unlock; # ロック中以外はロック解除
	($tn - $sts[9] < 15) || &unlock; # 約15秒以上ロックが続いてたら自動解除
	
	exit;
}



1;