perlからPHPへの書き換え補助

変数名	スカラー	配列	ハッシュ
history	●	●		historyを編集
admin_mail	●	●		admin_mailを編集
ver	●	●		verを編集
access	●	●		accessを編集
path	●	●	●	pathを編集
mode	●		●	modeを編集
subdir	●	●		subdirを編集
sort	●		●	sortを編集
pass	●		●	passを編集
user	●	●		userを編集
dir	●		●	dirを編集
param	●		●	paramを編集
mail	●	●	●	mailを編集
size	●		●	sizeを編集
decode_name	●		●	decode_nameを編集
perm	●	●		permを編集
download	●		●	downloadを編集
tm	●		●	tmを編集
tmp	●	●		tmpを編集
value	●	●		valueを編集
val	●		●	valを編集
oval	●	●		ovalを編集
time	●		●	timeを編集
kigen	●	●		kigenを編集
html	●	●		htmlを編集
raw_pass	●	●		raw_passを編集
msg	●	●		msgを編集
url	●	●		urlを編集
t	●	●		tを編集
rpass	●		●	rpassを編集
htac	●	●		htacを編集
del_htac	●		●	del_htacを編集
d	●	●		dを編集
new_raw_pass	●	●		new_raw_passを編集
dlmail	●		●	dlmailを編集
max_day	●		●	max_dayを編集
max_down	●		●	max_downを編集
new_user	●	●		new_userを編集
str	●	●		strを編集
salt	●	●		saltを編集
host	●		●	hostを編集
cook	●	●	●	cookを編集
dir_user		●	●	dir_userを編集

--------------------------------------------------------------------------------------------------

■以下の書式を変換します

qq() → "" 701件
my 除去 823件
my ()除去 124件
ハッシュから連想配列へ 276件
eq → === 130件
ne → !== 35件
elsif → elseif 72件
ループ中のnext → continue 9件
行末のifを変換 216件
ループ中のlast → break 22件
sub func { → function() { 71件
(stat($path))[9] → filemtime($path) 4件
(stat($path))[7] → filesize($path) 8件
正規表現のマッチを変換 81件
正規表現のマッチを変換(否定) 7件
正規表現の置換を変換(複数回) 65件
正規表現の置換を変換(1回のみ) 81件
-e → file_exists 39件
-f → is_file 9件
-d → is_dir 29件
int → intval 9件
関数呼び出し変更 422件
配列の要素数 17件
foreach文変更(要素名指定) 24件
foreach文変更(要素名省略) 75件を隠す以下の変換を実行

232行	foreach (@scr) {
	foreach ($scr as $_) {
695行	foreach (@user) {
	foreach ($user as $_) {
1077行	foreach (@file_list) {
	foreach ($file_list as $_) {
1135行	foreach (@file_list) {
	foreach ($file_list as $_) {
1262行	foreach (@raw_pass) {
	foreach ($raw_pass as $_) {
1287行	foreach (@html) {
	foreach ($html as $_) {
1308行	foreach (@config_value) {
	foreach ($config_value as $_) {
1426行	foreach (@subdir_list) {
	foreach ($subdir_list as $_) {
1729行	foreach (@list) {
	foreach ($list as $_) {
2056行	foreach (@user) {
	foreach ($user as $_) {
2080行	foreach (@template) {
	foreach ($template as $_) {
2113行	foreach (@user) {
	foreach ($user as $_) {
2120行	foreach (@raw_pass) {
	foreach ($raw_pass as $_) {
2143行	foreach (@template) {
	foreach ($template as $_) {
2169行	foreach (@body) {
	foreach ($body as $_) {
2353行	$url .= qq(?mode=login&dir=$dir&id=) . &url_encode($id) . qq(&time=$time); # ???id?????????????? foreach (@template) {
	$url .= qq(?mode=login&dir=$dir&id=) . &url_encode($id) . qq(&time=$time); # ???id?????????????? foreach ($template as $_) {
2477行	foreach (@body) {
	foreach ($body as $_) {
2494行	foreach (@file_list) {
	foreach ($file_list as $_) {
2602行	foreach (@admin_mail) {
	foreach ($admin_mail as $_) {
2771行	foreach (@config_value) {
	foreach ($config_value as $_) {
2865行	foreach (@htpass) {
	foreach ($htpass as $_) {
2905行	foreach (@user) {
	foreach ($user as $_) {
2915行	foreach (@raw_pass) {
	foreach ($raw_pass as $_) {
2952行	foreach (@user) {
	foreach ($user as $_) {
3090行	foreach (@new_user) {
	foreach ($new_user as $_) {
3127行	foreach (@raw_pass_list) {
	foreach ($raw_pass_list as $_) {
3139行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
3154行	foreach (@child_user_list) {
	foreach ($child_user_list as $_) {
3163行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
3207行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
3236行	foreach (@new_pass_list) {
	foreach ($new_pass_list as $_) {
3278行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
3312行	foreach (@log) {
	foreach ($log as $_) {
3330行	foreach (@log) {
	foreach ($log as $_) {
3348行	foreach (@log) {
	foreach ($log as $_) {
3406行	foreach (@user) {
	foreach ($user as $_) {
3537行	foreach(@access){
	foreach ($access as $_) {
3546行	foreach (@acc_list) {
	foreach ($acc_list as $_) {
3549行	# ?A?N?Z?X???O??????????[?U?[???????? foreach (@user) {
	# ?A?N?Z?X???O??????????[?U?[???????? foreach ($user as $_) {
3740行	foreach (@raw_pass) {
	foreach ($raw_pass as $_) {
3761行	foreach(@user){
	foreach ($user as $_) {
3800行	foreach (@login_list) {
	foreach ($login_list as $_) {
3857行	foreach (@perm) {
	foreach ($perm as $_) {
3950行	foreach (@updir_list) {
	foreach ($updir_list as $_) {
3958行	foreach (@htac) {
	foreach ($htac as $_) {
3968行	foreach (@id_list) {
	foreach ($id_list as $_) {
4008行	foreach (@del_list) {
	foreach ($del_list as $_) {
4017行	foreach (@del_list) {
	foreach ($del_list as $_) {
4038行	foreach(@access){
	foreach ($access as $_) {
4070行	foreach (@log) {
	foreach ($log as $_) {
4104行	foreach (@del_file_list) {
	foreach ($del_file_list as $_) {
4135行	foreach (@up_file_list) {
	foreach ($up_file_list as $_) {
4148行	foreach (@up_file_list) {
	foreach ($up_file_list as $_) {
4161行	foreach (@del_list) {
	foreach ($del_list as $_) {
4218行	foreach (@up_file_list) {
	foreach ($up_file_list as $_) {
4309行	foreach (@dir_list) {
	foreach ($dir_list as $_) {
4327行	foreach (@user) {
	foreach ($user as $_) {
4404行	foreach (@user) {
	foreach ($user as $_) {
4428行	foreach (@raw_pass_list) {
	foreach ($raw_pass_list as $_) {
4450行	foreach (@admin_mail) {
	foreach ($admin_mail as $_) {
4475行	foreach (@user) {
	foreach ($user as $_) {
4491行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
4514行	foreach (@raw_pass_list) {
	foreach ($raw_pass_list as $_) {
4527行	foreach (@raw_pass_list) {
	foreach ($raw_pass_list as $_) {
4551行	foreach (@pass_list) {
	foreach ($pass_list as $_) {
4623行	foreach (@admin_mail) {
	foreach ($admin_mail as $_) {
4653行	foreach (@user) {
	foreach ($user as $_) {
4944行	foreach (@node) {
	foreach ($node as $_) {
4957行	foreach (@history) {
	foreach ($history as $_) {
4970行	foreach (@history) {
	foreach ($history as $_) {
5064行	foreach (@config_value) {
	foreach ($config_value as $_) {
5193行	foreach (@user) {
	foreach ($user as $_) {
5315行	foreach (@admin_mail) {
	foreach ($admin_mail as $_) {
5750行	foreach (@cook) {
	foreach ($cook as $_) {
5876行	foreach (@del_list) {
	foreach ($del_list as $_) {

foreach (keys %ハッシュ)の変換 3件
配列初期化 16件
配列の@を$に変更(代入あり) 43件
配列の@を$に変更 489件
ハッシュの%を$に変更(代入あり) 52件
複数の変数に代入 60件
split → explode(要素名指定) 25件
split → explode(要素名省略) 44件
join修正 76件
mkdirに()をつける 14件
unlinkに()をつける 20件
カレントディレクトリを得る 1件
文字列中の配列要素を分離 50件
$ENV[環境変数] 15件

--------------------------------------------------------------------------------------------------

上記の置換パターンを編集する

--------------------------------------------------------------------------------------------------

現在のmultiupload_tmp.txtの内容

1		#!/usr/local/bin/perl
2		#################################################################
3		# ?}???`?A?b?v???[?hCGI #
4		#################################################################
5		my $explain = <<"EOF";
6		cgi.pm??g???t?@?C????A?b?v???[?h???GI???B?????t?@?C????????A?b?v???[?h?????B
7		?A?b?v???[?h????t?@?C????T?C?Y?A????????????????ACGI?t?@?C??????????????????[?U?[???A?b?v???[?h?????B
8		?S?p?????t?@?C??????????????????????AURL?G???R?[?h???A?b?v???[?h??A?u???E?U??t?@?C?????\?????????RL?f?R?[?h??????B
9		?o?^???[?U?[???A?N?Z?X??\??A???[?U?[????A?N?Z?X????f?B???N?g???A?A?b?v???[?h??\??e??A??\?????????????B
10		??\?????????????B
11		?t?@?C????A?b?v???[?h?A?_?E?????[?h?????A?T?u?f?B???N?g??????A????A?p?[?~?b?V???????X?B?t?@?C???A?f?B???N?g????f?B???N?g??????1?K?w???
12		?y??????????z
13		???[?U?[????A????e??X?B???[?U?[??A?N?Z?X???O????A?{???B
14		??????p?X???h???X?B
15		?A?b?v???[?h????w??????o????t?@?C??????????B
16		EOF
17		#===============================================================
18		my $history = <<'EOF';
19		ver.1.00 2010.03.31 ???ver.1.01 2010.04.01 ??{????t?@?C????A?b?v???[?h????A?????????????????A?????uc?????A??xsjis???????????B
20		ver.1.1 2010.04.02 ?p?X???h???A???[?U?[????@?\??????B
21		ver.1.11 2010.04.05 ?N?b?L?[?@?\?A?p?[?~?b?V??????@?\????B
22		ver.1.12 2010.04.06 ???e??????A?b?v???[?h?????????????????B
23		ver.1.13 2010.04.12 ?????[?U?[???o?^???????????????A?????????W???A?J?E???g???O????o?^????G?\|?b?N????I??????C??B
24		ver.1.14 2010.04.13 ?o?^???[?U?[??f?B???N?g???????f?B???N?g??????K?w???[??f?B???N?g??????????????C??B
25		ver.1.15 2010.04.14 ?t?@?C???A?f?B???N?g??????@?\????B
26		ver.1.16 2010.04.19 .htaccess????A?N?Z?X???@?\????B?????[?U?[????o?^????????X?B???f?B???N?g?????ndex.html?????????B
27		ver.1.17 2010.04.19 ?x?[?V?b?N?F??rypt???p?X???h??g???????A.htpasswd??p?X???h??ser.cgi????????????g???????ver.1.18 2010.04.21 ?X?N???v?g?????????????u???E?U???W??????C??B
28		ver.1.19 2010.04.23 ?S?p????????f?B???N?g?????????????X?B???t?@?C???????????A.htaccess??ndex.html???????????????C??B
29		ver.1.20 2010.08.13 ??{?????R?[?h???C?u??????code.pm??I??????C??B?????????w???????o????t?@?C?????????????A?T?u?f?B???N?g?????t?@?C???????o???????????????o?O??C??B
30		ver.1.21 2010.08.18 ?o?b?N?A?b?v?t?@?C??????X?B
31		ver.1.22 2010.09.21 ?t?@?C???_?E?????[?h??RL????[?U?[ID?A?p?X???h???????p??B(InternetExplorer???
32		ver.1.23 2010.09.24 ????????????A???[?U?[??o?^??e??`?????[??????M?????????B???[?U?[???????p?X???h???????????B
33		ver.1.3 2010.09.27 ???[?U?[?????V?K?o?^????????X?B
34		ver.1.31 2010.09.28 ???[?U?[??o?^?E?t?@?C????A?b?v???[?h???A?????????[?????m???@?\????B
35		ver.1.32 2010.10.04 crypt???p?X???h????????????A?f?B???N?g???????s???????????A??????????Acrypt??????s???????B
36		????A?A????rand()??s?????????????????eed????????????????B
37		ver.1.33 2010.10.05 ?f?B???N?g??????????A?T?u?f?B???N?g????????G???[????????C??B
38		ver.1.34 2010.10.06 ???[?U?[?o?^??A?????????V?K???[?U?[?o?^?A?o?^??e??X????t?@?C?????b?N???????X?B?A?b?v???[?h???t?@?C???T?C?Y???????????????B
39		ver.1.35 2010.10.07 ?f?B???N?g?????ndex.html??????????????A????????????????C??Bindex.html??????????????I?????????C??B
40		??????????[?????M??????????????C??Bcrypt???p?X???h??????????????X?B
41		ver.1.36 2010.10.12 .htaccess????A?N?Z?X????s?????A??????p?X???h???X??????A???[?U?[????htpasswd???????p?X???h???X???f???????????C??B
42		ver.1.37 2010.10.14 ???[?U?[??o?^??????A?x?[?V?b?N?F?o?????o?O??C??B
43		ver.1.38 2010.10.15 ???[?U?[?????t?@?C???????o??A?o?[?W?????A?b?v????????t?@?C????????o?????????B
44		ver.1.381 2010.10.18 config.cgi????????????>???X?B
45		ver.1.39 2010.10.19 config.cgi???????????A?l????w???????????f???????????C??B
46		?t?@?C???T?C?Y????????t?@?C????A?b?v???[?h????????s?????A??T?C?Y??t?@?C????c??????????????C??B
47		ver.1.4 2010.10.20 ???[?U?[?o?^???e???o?^??????A???[?U?[???????????X?B
48		ver.1.41 2010.10.21 ????????[?h????O?C?????????????A???[?U?[???[?h????O?C????????[?U?[?????????N??\????????X?B
49		ver.1.42 2010.10.22 ???[?U?[?o?^??e???X?????A?o?^?????????A???[???????l???m??????C??B
50		ver.1.43 2010.10.29 ???O?C????????[?U?[??p?f?B???N?g?????\?????????C??B
51		ver.1.44 2010.11.05 ???[?U?[?o?^????????f?B???N?g?????????????????????C??B
52		ver.1.45 2010.11.10 ???[?U?[?o?^?????e?????X?N???v?g????u?f?t?H???g????e??v???f??????????C??B
53		.htaccess?t?@?C?????????????B
54		ver.1.46 2010.11.12 ???[?U?[?????????$max_user_id??w???B
55		ver.1.47 2010.11.15 ?A?b?v???[?h?t?@?C?????????@?\???B
56		ver.1.50 2010.11.26 ?t?@?C??????n????????[????A?b?v???[?h?A?_?E?????[?h??RL????M????????X?B
57		ver.1.51 2011.01.26 ?t?@?C????RL????w????_?E?????[?h???????ACGI??_?E?????[?h???????X?B
58		?????????A??{???t?@?C?????{?????_?E?????[?h?????????A?x?[?V?b?N?F??p?X???h????K?v???????B
59		?t?@?C?????n???????[?????M?t?H?[????A?{???C???v???r???[???f?????????o?O??C??B
60		ver.1.52 2011.01.27 ?t?@?C???_?E?????[?h??RL??C??B?t?@?C?????n???????[?????M?t?H?[????A???[???^?C?g?????W??\??C??B
61		???[?????????t?@?C?????n??????A???[?U?[???A???[?????M?A?f?B???N?g?????A?f?B???N?g??????????????[?U?[???[?h????O?C????????C??B
62		ver.1.53 2011.01.29 ???[?U?[ID?A?p?X???h??N?b?L?[??????????I????????C??B???[?U?[?o?^???o?^??e????[??????M???????C??B
63		ver.1.54 2011.01.31 ?????[?U?[?????[?????M??A??s??????????????????C??B
64		ver.1.55 2011.02.01 ??????p?X???h???s?R?[?h???????????A?????[?U?[??p?X???h?????s?????????????C??B
65		???[???A?h???X??o?^????[?U?[??RL???[?????M?t?H?[????g???????X?B
66		?o?^???[?U?[???g??o?^???????A??p?X???h??o?^??c??????????C??B
67		ver.1.56 2011.02.02 ?t?@?C???_?E?????[?h??RL??????p?X???h???????B?J?????g?f?B???N?g????A?N?Z?X???Q?X?g???[?h??RL??\?????????C?B
68		?t?@?C??????p???????????_?E?????[?h???s?????C??B
69		ver.1.57 2011.02.03 ???????????X?N???v?g??????X??????A?X?N???v?g????X???????s???W??????????C??B
70		?????????????C?A?E?g?????X?B
71		ver.1.58 2011.02.04 ?f?B???N?g??????p?????g?p?????A????????????A_(?A???_?[?o?[)????????C??B
72		ver.1.59 2011.02.07 base64????imew.pl??s????C??Bconfig.cgi????????????s????????????C??B
73		ver.1.60 2011.02.08 ???b?N???????B?????????????[?U?[??g?p??????f?B???N?g??????????????????B
74		ver.1.61 2011.02.10 ?p?X???h??g?p??????????????g?p????????C??#;&+????B?????????????C?A?E?g??C??B
75		???[?U?[ID??p?X???h??(?J???})??g???G???[??????C??B
76		ver.1.62 2011.02.15 ?p?X???h??????@?\????B???????????[?U?[??\??????????????X?B
77		ver.1.70 2011.02.16 ???????????\?????ub admin??S?`???S?`?????????A??????S??I???????B
78		?o?^???[?U?[????A??g?p??f?B???N?g??????????A?A?b?v???[?h?t?@?C???????\???@?\???B
79		???[????e???v???[?g??O???t?@?C??????B
80		ver.1.71 2011.02.22 ?p?X???h??????{?^????????A???p?X???h?t?H?[?????????????X?B
81		?p?X???h?V?K??????C?????assword?t?H?[???????Atext?t?H?[????g?p??A?????????p?X???h?????m?F?????????B
82		?p?[?~?b?V???????X???????f???????????C??B
83		ver.1.72 2011.03.04 ?t?@?C????_?E?????[?h?????J?E???g???????C??B
84		??????????[?U?[????[?U?[?????[?U?[?????X???????C??B
85		ver.1.73 2011.03.09 ???[?g?f?B???N?g??(?A?b?v???[?h?p????f?B???N?g??)?????f?B???N?g?????A?N?Z?X??????[?h?????????????B
86		ver.1.74 2011.03.25 ver.1.73??f?B???N?g??????A?f?B???N?g???\???????????????C??B
87		ver.1.75 2011.03.29 ???[?U?[????A?N?Z?X???O??L?^?????C??B
88		ver.1.76 2011.04.14 ???[?????M?t?H?[????C?ABCC??\?????????C??B?A?b?v???[?h???t?@?C????????????????????C??B
89		ver.1.77 2011.05.11 Jcode.pm??g?p??????????R?[?h???C?u??????code.pm??w???????A?x????o?????C??B
90		ver.1.78 2011.05.18 ??????p?w???v????B
91		ver.1.79 2011.05.27 .htaccess????A?N?Z?X????s????????A??p?X???h???????A?A?b?v???[?h???t?@?C????_?E?????[?h?????o?O??C??B
92		ver.1.8 2011.05.29 ?p?X???h???f?B???N?g???????????????A????I??f?B???N?g???????????????B
93		???[?U?[?????X???\????[?U?[?????A?t?@?C????_?E?????[?h???s?????????[?U?[?????????????b?Z?[?W??o???????B
94		ver.1.81 2011.05.31 .htaccess??g????????Amultiupload?f?B???N?g?????htaccess?t?@?C?????????????B
95		???????????[?U?[?????p?X???h??W????????????A???[????\??????????B
96		ver.1.82 2011.06.08 ?t?@?C????_?E?????[?h????C??B
97		ver.1.83 2011.06.14 ?t?@?C????A?b?v???[?h????C??B?t?@?C???T?C?Y??`?F?b?N???????i?K??s???????B?A?b?v???[?h???????????\??????????B
98		ver.1.84 2011.06.21 ?Q?X?g???[?h???f?B???N?g????????????????B?A?b?v???[?h??~?g??q???W??\????B
99		ver.1.85 2011.07.21 ???_?E?????[?h???????????A??????_?E?????[?h????t?@?C??????????????B
100		ver.1.9 2011.07.29 ?Q?X?g??F???????????X(???[?????M???Q?X?g?p?p?X???h??????A?L???????????????????B????Q?X?g??????Q?X?g????B
101		??p?f?B???N?g??????[?U?[??h????B
102		ver.1.91 2011.07.29 ?f?B???N?g?????g?p???????????&"????B
103		ver.1.92 2011.08.01 ?Q?X?g?????[?????M?t?H?[????\??????L?????????s???????C??B
104		ver.1.93 2011.08.17 ?o?^???[?U?[??f?B???N?g??????A?L????????A?J?E???g??c???????\????????C??B
105		ver.1.931 2011.10.18 ?????Q?X?g?A?J?E???g?A?C?R????\|?b?v?A?b?v????R?????g??C??B
106		ver.1.94 2012.04.13 CGI??????t?H?[??????s??I?v?V????????B$post_only ??1 ????B
107		ver.1.941 2012.05.02 ???O?C???t?H?[????????N????A?????????N??\?????????????B$show_return ??1 ????A$return_url ??RL??L????B
108		ver.1.942 2012.06.27 ?A?b?v???[?h???t?@?C????????????A?????`?F?b?N???????A???[?????M?t?H?[????u????`?F?b?N?v?{?^??????????B
109		ver.1.943 2012.08.15 ???[????M?????h?????????\|?X?N???v?g??????X???????????B
110		???[?????M???A?t?@?C?????_?E?????[?hURL??\???????????????\|?X?N???v?g?????X???????????B
111		ver.1.95 2012.08.17 ?Q?X?g??t?@?C????_?E?????[?h????A???[?U?[????[????m????I?v?V????????????B
112		?????????send_dlmail ??1 ????A?e???[?U?[??????u?t?@?C????_?E?????[?h???????[????m????v??`?F?b?N????L???????B
113		ver.1.951 2012.08.24 ?Q?X?g??O??t?@?C????_?E?????[?h????A?_?E?????[?h??m???[??????M???????o?O??C??B
114		?????????????M???[????h??L?????????????C??B
115		???[?U?[???[?h??A???O?C????????[?U?[????X????Q?X?g?A?C?R????\???????????C??B
116		ver.1.952 2012.08.27 ???[?U?[????t?@?C???_?E?????[?h????[????m???????????m???[??????M???????o?O??C??B
117		ver.1.96 2012.12.05 ?????ID??g?p????????A????????[?h????O?C?????????X?B
118		ver.1.961 2012.12.11 ??????p?X???h??o?^???[?U?[????O?C??????????X?B???????????[?U?[????????o?^???[?U?[ID???????p?X???h????O?C?????????C??B
119		ver.1.97 2013.03.18 ????????Q?X?g??p??BCGI????????t?H?[????s????f?t?H???g??????B???[??????M?????O?C??URL?A?_?E?????[?hURL???p?X???h?????B
120		ver.1.971 2013.03.22 ???O?C????R?k?h?????A???O?C??????p?X???h?F??s??A???O?C???????y?[?W????A?N?V??????A????p?X???h?t?@?C????F???????X?B
121		???[?U?[??????w???v?t?@?C???????????C??B
122		ver.1.972 2013.03.28 ?Q?X?g???A???[?U?[????e??????t?@?C????A?b?v???[?h????o?O??C??B?v???V?[?W??????Bperl5.12??~??code.pl??G???[??o????C??B
123		ver.1.973 2013.04.11 ?T?[?o?[??endmail?R?}???h??f?I?v?V??????????A???[??????M???T?[?o?[????[???A?h???X??????????????B
124		?Q?X?g?????M???[??????M?????[?U?[?????B
125		???[?U?[???Q?X?g???_?E?????[?h???m???[????A??x????????[???A?h???X????M???????C??B
126		ver.1.974 2013.04.12 ?f?B???N?g?????g?p???????????#"?A"%"????B??????L????f?B???N?g?????g?p??????????????????????????C??B(!'~=()[]-^???
127		ver.1.975 2013.04.16 ?Z?L?????e?B?????C??B
128		ver.1.976 2013.04.17 ?????????????[?U?[?A?J?E???g??A?X?N???v?g???????_?E?????[?h??????f???????????C??B
129		ver.1.977 2014.02.12 ?p?X???h???????igest::MD5???W???[????g?p????????X?B
130		EOF
131
132		#===============================================================
133		# config_start ???[?U?[???y?????????z
134		my $title = '?}???`?A?b?v???[?_'; # CGI??^?C?g??
135		my $simple_title = $title;
136		my $admin_name = '????l'; # ????????O?B???????????????[?????M????O?\??????g?p?B
137		my $admin_id = 'admin'; # ???????D?B???O?C?????g?p?B
138		my $admin_mail = ''; # ?????????[???A?h???X?B???????M???????(?J???})?????B
139		my @admin_mail = split(/,/,$admin_mail);
140		my $sendmail = '/usr/lib/sendmail'; # sendmail??p?X
141		my $code = 2; # ??????@(1:crypt 2:MD5)
142		my $adminpass = ''; # ??????p?X???h?B???????O?C?????u???E?U?????????rypt??????????A?????????????B
143		my $post_only = 0; # CGI?????????t?H?[????s??my $user_regist = 1; # ???[?U?[????o?^????t???0=???t???? 1=???t???
144		my $free_mode = 0; # ???[?g?f?B???N?g??????????????????
145		my $user_mail_neces = 0; # ???[???A?h???X??o?^??K?{????0=?K?{????? 1=?K?{????
146		my $chk_mail = 1; # ???[???A?h???X???????`?F?b?N???0=?`?F?b?N???? 1=?`?F?b?N???
147		my $mail_notify = 1; # ???[?U?[?o?^?A?t?@?C????A?b?v???[?h?????l????[?????m???0=??m????@1=??m???
148		my $mr = '???; # ???M??????h?my $pass_length = 5; # ?p?X???h??????my $auto_pass_length = 10; # ?????????p?X???h???????l
149		my $ban = ';&#"+'; # ?p?X???h??g?p???????
150		my $max_user_id = 32; # ???[?U?[????????p??
151		my $make_index = 1; # ?A?b?v???[?h?f?B???N?g?????????????ndex.html??????B(0=??????@1=?????
152		my $hide_index = 1; # ?A?b?v???[?h?f?B???N?g?????ndex.html??B??B(0=?B????@1=?B??
153		my $use_htaccess = 1; # .htaccess????A?N?Z?X????s??B(0=?s????@1=?s??
154		my $passdir = ''; # .htaccess??p?X???h?t?@?C?????f?B???N?g???B??????p?X???h????????I????????B
155		my $show_cc = 0; # ???[?????M?t?H?[????C?ABCC??????B
156		my $hide_file_download_url = 0; # ???[?????M???A?t?@?C?????_?E?????[?hURL??\??????my $show_dl_count = 1; # ?_?E?????[?h?????J?E???g???B(0=?J?E???g????@1=?J?E???g???
157		my $send_dlmail = 1; # ?Q?X?g??t?@?C????_?E?????[?h????????[?U?[????[????m????my $max_dl_count = 10; # ???_?E?????[?h???(??????_?E?????[?h??????)
158		my $max_user = 20; # ??????????x??\???????[?U?[??
159		my $save_num = 1000; # ?A?N?Z?X???O????
160		my $login_term = 10; # ???O?C????L?????????O?C???????????????????O?C?????????my $c_val_term = 30; # ?N?b?L?[??L??????
161		my $title_back_col = '#0066ff'; # ?^?C?g???w?i?F
162		my $title_font_size = '110%'; # ?^?C?g????t?H???g????my $zebra_back_col = '#eeeedd'; # ?[?u???\???p?w?i?F
163		my $upnmb = 8; # ?????A?b?v???[?h????t?@?C?????
164		my $show_process = 1; # ????????\?????B(0=?\??????@1=?\?????
165		my $show_process_time = 1; # ?A?b?v???[?h?v????\?????B(0=?\??????@1=?\?????
166		my $upload_type = 1; # ?A?b?v???[?h?????(0=??????@1=?V???
167		my $max_file_mb = 1000; # ?A?b?v???[?h???t?@?C???T?C?Y?????P??B)
168		my $max_file_size = 1024 * 1024 * $max_file_mb;
169		my $prohibit_ext = 'cgi,pl,php,vbs,js,sh'; # ?A?b?v???[?h??~??g??q(,(?J???})?????
170		my $life = 10; # ?A?b?v???[?h?t?@?C?????????????????
171		my $auto_delete = 7; # ?A?b?v???[?h?t?@?C?????????????(0=??????????
172		my $delete_log = 1; # ??????????O??L?^???0=?L?^????
173		my $max_mb = 80; # ???[?U?[??p?f?B???N?g????f?t?H???g????e??MB)
174		my $encode_lib = 1; # ????R?[?h???C?u????(0=jcode.pl?@1=Jcode.pm)
175		my $show_return = 0; # ???O?C???t?H?[??????????N??\?????my $return_url = ''; # ???O?C???t?H?[????\????????my $return_name = ''; # ??????O
176		my $htaccess = '.htaccess';
177		my $config_file = 'config.cgi'; # ?????t?@?C??
178		my $sample = 0; # ?T???v???????A?Q?X?g?A?J?E???g????[???A?h???X??\??????# config_end ???[?U?[???I??y?????????z
179		my @config = ('title','admin_name','admin_id','admin_mail','sendmail','code','post_only','user_regist','free_mode','user_mail_neces','chk_mail','mail_notify','mr','pass_length','auto_pass_length','max_user_id','make_index','hide_index',
180		'use_htaccess','show_cc','hide_file_download_url','show_dl_count','send_dlmail','max_dl_count','max_user','save_num','login_term','c_val_term','title_back_col','title_font_size','zebra_back_col','upnmb','show_process','show_process_time','upload_type','max_file_mb',
181		'prohibit_ext','life','auto_delete','delete_log','max_mb','encode_lib','show_return','return_url','return_name','sample');
182		#===============================================================
183
184		use strict;
185		use warnings;
186		no warnings qw(redefine);
187		no warnings qw(uninitialized);
188
189		my @ver = $history =~ /ver\.?(\d+\.\d*)/g;
190		my $ver;
191		foreach my $version (@ver) {
192		$ver = $version if $version > $ver;
193		}
194
195		use CGI qw/:standard/;
196		use File::Basename;
197
198		my $save_log = 2;
199		my $access = './access.log';
200		my $lockdir = './lock';
201		my $lockkey = 2;
202		my $lockflag;
203		my $lock = 1;
204		my $lockfile = 'upload.lock';
205		my $cookname = 'multiupload';
206		my $access_dir = './axs';
207		my @del_list; # ??????t?@?C??????X?g
208		my $script = 'multiupload.cgi'; # ?X?N???v?g?t?@?C????
209		if (! $code) {
210		# ??????@??????????X?N???v?g?t?@?C????????? use File::Find;
211		# MD5???W???[????C???X?g?[??????????????? my $md5ok;
212		find(\&mdsearch, @INC);
213		sub mdsearch {
214		if ($_ eq 'MD5.pm') {
215		$md5ok = 1;
216		return $md5ok;
217		}
218		}
219		&lock;
220		open(SCR,$script) \|\| &error("$script??J?????B");
221		my @scr = <SCR>;
222		close(SCR);
223
224		my $code_str;
225		if ($md5ok) {
226		$code_str = 'my $code = 2;' . "\t" x 9 ."# ??????@(1:crypt 2:MD5)\n";
227		} else {
228		$code_str = 'my $code = 1;' . "\t" x 9 ."# ??????@(1:crypt 2:MD5)\n";
229		}
230		open(SCR,">$script");
231		my $flag;
232		foreach (@scr) {
233		if (/^\smy\s+\$code\s=/) {
234		print SCR $code_str;
235		$flag = 1;
236		} else {
237		if (! $flag && /^\smy\s+\$adminpass\s=/) {
238		print SCR $code_str;
239		}
240		print SCR $_;
241		}
242		}
243		close(SCR);
244		&unlock;
245		}
246
247		my $debug = '';
248		my $header_flag;
249		my $error_header = 0;
250		my $updir = my $root = './upload/';
251		my $user_root2 = $root . 'root';
252		my $user_root = 'usr_root'; # ???[?U?[??o?^??????A?b?v???[?h?p???[?g?f?B???N?g??
253		$user_root = $root . $user_root;
254		my $regist_user;
255		my %mod_list;
256		my ($start_sec,$start_msec) = &get_microsec if $show_process_time;
257		my $del_day; # ?Q?X?g?L????my $dir_owner; # ?A?N?Z?X?????f?B???N?g????I?[?i?[??
258		$updir =~ s/\/+$//;
259		$root =~ s/\/+$//;
260		if (! -e $root) {
261		mkdir $root; # ???[?g?f?B???N?g????????????? if ($make_index) {
262		open(INDEX,">" . join('/',$root,'index.html') );
263		close(INDEX);
264		}
265		}
266
267		use Cwd 'realpath';
268		my $path = my $fullpath = Cwd::realpath( '.' ); # ???[?g?f?B???N?g????t???p?X????my $file_nmb = 0; # ?t?@?C???????
269		my $dir_nmb = 0; # ?t?H???_?????
270		my @up_file_list; # ?A?b?v???[?h??????t?@?C??????X?g
271
272		my $mode = param('mode');
273		my ($prm_sec,$prm_msec) = &get_microsec if $show_process_time; # ?A?b?v???[?h????\?????????A????f?[?^???M????v??my $current_dir = param('dir');
274		my $subdir = param('subdir');
275		my $show_size = param('show_size');
276		my $newdir = param('mkdir'); # ?????f?B???N?g????# ?f?B???N?g????`?F?b?N
277		if ($newdir =~ /[^\x01-\x7E]/) {
278		&error('?G???[',"?f?B???N?g?????S?p?????g?p?????????B");
279		}
280		if ($newdir =~ /([\\\+;\?\*&%#\$])/) {
281		&error('?G???[',"?f?B???N?g?????u" . $1 . "?v??g?p?????????B");
282		}
283		my $target = param('target'); # ?t?@?C???A?f?B???N?g???????my $delete_file = param('delete_file');
284		my $file_path = param('file_path');
285		$file_path =~ s/ /+/g;
286		my $file = param('file');
287		my $ch_mod = param('ch_mod');
288		my $sort = param('sort');
289		my $id = param('id');
290		my $pass = param('pass');
291		my $tpass = param('tpass');
292		my $login_user = param('login_user') if param('login_user');
293		my $login_guest = param('login_guest') if param('login_guest');
294		my $login_admin = param('login_admin') if param('login_admin');
295		my @dir_list;
296
297		# ??????p?X???h??????????????my @config_value;
298		if (!$adminpass) {
299		&admin_pass;
300
301		# ?p?X???h???f?B???N?g????????????????} elsif (! $passdir) {
302		&make_passdir;
303		}
304		my $logindir = join('/',$passdir,'login');
305		mkdir $logindir if ! -d $logindir;
306		if (! -e join('/',$logindir,'index.html')) {
307		open(INH,">" . join('/',$logindir,'index.html'));
308		close(INH);
309		}
310
311		# ?????O?C???t?@?C??????
312		opendir(DIR,$logindir);
313		while (my $file = readdir(DIR)) {
314		next if $file !~ /\w{10}\.cgi$/;
315		my $path = join('/',$logindir,$file);
316		if ((stat($path))[9] < time - $login_term * 60) {
317		unlink $path; # $login_term?????????????
318		}
319		if ((stat($path))[10] < time - 60 * 60) {
320		unlink $path; # ???O?C????????????????
321		}
322		if ($file eq $ENV{'REMOTE_ADDR'} . param('logout') . 'admin.cgi' \|\| $file eq $ENV{'REMOTE_ADDR'} . param('logout') . 'user.cgi' \|\| $file eq $ENV{'REMOTE_ADDR'} . param('logout') . 'guest.cgi') {
323		unlink $path; # ???O?A?E?g??????
324		}
325		}
326		closedir(DIR);
327
328		# index.html????if (! -e './index.html') {
329		open(IND,">./index.html");
330		print IND <<"EOF";
331		<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
332		<html lang="ja">
333		<head>
334		<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
335		<META HTTP-EQUIV="Refresh" CONTENT="0; URL=$script">
336		<title>?W?????v</title>
337		</head>
338		<body>
339		????I???????????A<a href="$script" target="_top"><storng>???/strong></a>??N???b?N???????B
340		</body>
341		</html>
342		EOF
343		close(IND);
344		}
345
346		if ($use_htaccess && ! -e './.htaccess') {
347		open(HTA,">./.htaccess");
348		print HTA qq(Options -Indexes\n);
349		close(HTA);
350		}
351		# ???A?b?v???[?h?t?@?C??????
352		if ($auto_delete) {
353		&delete_old($root,$auto_delete);
354		if ($delete_log && @del_list) {
355		&delete_log(@del_list);
356		}
357		}
358		if ($mode eq 'history') {
359		&history;
360		exit;
361		}
362
363
364
365
366		# ID??p?X???h???????????O?C???t?H?[????\??
367		if ((!$id && ! $login_user && ! $login_admin && ! $login_guest) \|\| (!$pass && !$tpass) && ! $login_guest && ! $login_user && ! ($login_admin && -e join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi')) ) {
368		&login($mode);
369		exit;
370		}
371		my ($usr_perm,$usr_max_size,$user_mode,@user);
372		if (open(USR,"./user.cgi")) {
373		@user = <USR>;
374		close(USR);
375		}
376		my (%tm, %mail, %max_day, %max_down, %dlmail);
377		my $administrator; # ???????????O?C????????A??????t???O?????my $user_admin; # ?????????[?U?[???[?h????O?C????????t???O
378		my $login_admin_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi') if $login_admin;
379		my ($comment, $err_comment);
380		if ($login_admin \|\| ($id eq $admin_id && &decrypt($pass,$adminpass) eq 'yes')) {
381		if ($login_admin) {
382		if (-e $login_admin_path) {
383		open(GID,$login_admin_path);
384		$id = <GID>;
385		chomp $id;
386		close(GID);
387		open(LGI,">$login_admin_path");
388		print LGI $id;
389		close(LGI);
390		$administrator = 1;
391		} else {
392		&login($mode,'????O?C?????????);
393		exit;
394		}
395		} else {
396		$administrator = 1;
397		if ($mode eq 'login') {
398		&set_cookie($id,$pass,param('save_cook'));
399		&save_accesslog() if $save_log;
400		}
401		if (length($pass) > 8 && length($adminpass) == 13) {
402		$comment .= qq(<div style="color:red">8???????p?X???h??g?p????????A????????????L??????????B<br>\n);
403		$comment .= qq(9??????~??L???????A????????u??????p?X???h??X?v????x?o?^???????B</div>\n);
404		}
405		undef $pass;
406		$login_admin = &random_str(10);
407		my $login_file = $ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi';
408		my $login_path = join('/',$logindir,$login_file);
409		open(LGI,">$login_path");
410		print LGI $id;
411		close(LGI);
412		}
413		} else {
414		if (! -e './user.cgi') {
415		open(NEW,">./user.cgi");
416		close(NEW);
417		}
418		# ???[?U?[??????O?C???????????
419		my ($ex_login_user, $ex_login_guest); # ???O?C???t?@?C???????????? my $login_user_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_user . 'user.cgi') if $login_user;
420		my $login_guest_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_guest . 'guest.cgi') if $login_guest;
421		if ($login_user && -e $login_user_path) {
422		$ex_login_user = 1;
423		open(GID,$login_user_path);
424		$id = <GID>;
425		chomp $id;
426		close(GID);
427		}
428		# ?p?X???h???????A???[?U?[??????O?C????????
429		if ($pass \|\| $ex_login_user) {
430		my $pass_ok = 0;
431		my $rtm;
432		my $coded;
433		foreach my $line (@user) {
434		my list($tm, $user, $path, $e_pass, $permit, $l_size, $mail,$max_day,$max_down,$dlmail) = explode('\,',$line);
435		$user = &rechange($user);
436		if ($user eq $id) {
437		if (&decrypt($pass,$adminpass) eq 'yes') {
438		$user_admin = 1;
439		}
440		if (! $ex_login_user && &decrypt($pass,$e_pass) eq 'no' && ! $user_admin) {
441		$pass_ok = -1;
442		} else {
443		$updir = $root = $path;
444		$updir =~ s/\/+$//;
445		$pass_ok = 1;
446		$usr_perm = $permit;
447		$usr_max_size = $l_size;
448		$rtm = $tm;
449		$mail{"$user"} = $mail;
450		$tm{"$user"} = $tm;
451		$max_day{"$user"} = $max_day;
452		$max_down{"$user"} = $max_down;
453		$dlmail{"$user"} = $dlmail;
454		$user_mode = 1;
455		$coded = $e_pass;
456		last;
457		}
458		}
459		}
460		if ($pass_ok == 0) {
461		&error("???O?C???G???[","?u${id}?v???o?^????????B");
462		} elsif ($pass_ok == -1) {
463		&error("???O?C???G???[","?p?X???h??????B");
464		} elsif ($mode eq 'login') {
465		$login_user = &random_str(10);
466		my $login_file = $ENV{'REMOTE_ADDR'} . $login_user . 'user.cgi';
467		my $login_path = join('/',$logindir,$login_file);
468		open(LGI,">$login_path");
469		print LGI $id;
470		close(LGI);
471		&set_cookie($id,$pass,param('save_cook')) if ! $user_admin;
472		&save_accesslog($rtm) if $save_log && ! $user_admin;
473		if (length($pass) > 8 && length($coded) == 13) {
474		$comment .= qq(<div style="color:red">8???????p?X???h??g?p????????A????????????L??????????B<br>\n);
475		$comment .= qq(9??????~??L???????A????????u???[?U?[???v????x?p?X???h??o?^???????B</div>\n);
476		}
477		undef $pass;
478		} elsif ($ex_login_user) {
479		open(LGI,">$login_user_path");
480		print LGI $id;
481		close(LGI);
482		}
483
484		# ?Q?X?g??????O?C???????????
485		} elsif ($tpass \|\| ($login_guest && -e $login_guest_path) ) {
486		&error('?G???[','????RL???) if ! param('time') \|\| ! param('dir'); # ??????K?v??p?????[?^???????A?A?N?Z?X???? my $dir = param('dir');
487		$dir =~ s/^\.\///;
488		if ($login_guest && -e $login_guest_path) {
489		$ex_login_guest = 1;
490		open(GID,$login_guest_path);
491		$id = <GID>;
492		chomp $id;
493		close(GID);
494		}
495		my $rtm;
496		foreach my $line (@user) {
497		my list($tm, $user, $path, $e_pass, $permit, $l_size, $mail,$max_day,$max_down) = explode('\,',$line);
498		$user = &rechange($user);
499		# ???[?U?[?f?[?^???p?[?~?b?V??????A???[?U?[?o?^???A???_?E?????[?h????f?[?^????B
500		if ($user eq $id) {
501		$usr_perm = $permit;
502		$rtm = $tm;
503		$max_down{"$id"} = $max_down;
504		$usr_max_size = $l_size;
505		last;
506		}
507		}
508		my $tpass_path = join('/',$passdir,$dir,param('time') . '.cgi'); # ?Q?X?g?F?p?p?X???h?t?@?C????p?X
509		if (open(PAS,"$tpass_path")) {
510		my $cnt = <PAS>;
511		close(PAS);
512		my list($crypass,$updir,$del_day) = explode('<>',$cnt);
513		$max_day{"$id"} = $del_day;
514		if ($tpass) {
515		if (&decrypt($tpass,$crypass) eq 'no') {
516		&error("???O?C???G???[","?p?X???h??????B");
517		} elsif ($mode eq 'login') {
518		$login_guest = &random_str(10);
519		my $login_file = $ENV{'REMOTE_ADDR'} . $login_guest . 'guest.cgi';
520		my $login_path = join('/',$logindir,$login_file);
521		open(LGI,">$login_path");
522		print LGI $id;
523		close(LGI);
524		undef $tpass;
525		&save_accesslog($rtm) if $save_log;
526		}
527		}
528		# ?L????????p?X???h?t?@?C??????????A???O?C?????????????A???????????????????????????????????A
529		# ?p?X???h?t?@?C????????A???O?C????t?@?C????_?E?????[?h????s??B?????R?????????O?C??????????B
530		if ($del_day ne 'p' && ($mode eq 'login' \|\| $mode eq 'download') && param('time') + $del_day * 3600 * 24 < time) {
531		unlink $tpass_path; # ?????????p?X???h?t?@?C??????
532		&error('?G???[','???O?C????????B?L??????????B');
533		}
534		} else {
535		&error('?G???[','???O?C????????B???????\????????B');
536		}
537		if ($ex_login_guest) {
538		open(LGI,">$login_guest_path");
539		print LGI $id;
540		close(LGI);
541		}
542		} elsif ($login_guest && ! -e $login_guest_path) {
543		&login('','????O?C?????????);
544		exit;
545		} elsif ($login_user && ! -e $login_user_path) {
546		&login('','????O?C?????????);
547		exit;
548		}
549		}
550		#my ($comment, $err_comment);
551		if (!-d $root) {
552		mkdir $root;
553		if ($make_index) {
554		open(INDEX,">" . join('/',$root,'index.html') );
555		close(INDEX);
556		}
557		$comment .= qq(<span style="color:red">${root}?f?B???N?g????????????????B</span>);
558		}
559
560		# ????????[?h????
561		if ($mode eq 'admin') {
562		if (! $administrator) {
563		if ($login_admin) {
564		undef $login_admin;
565		&login($mode);
566		exit;
567		} else {
568		&error("??????????????B",qq(??????????????????????A?J?E???g?????O?C?????????B<a href="$script?mode=admin">????O?C??</a>));
569		}
570		} else {
571		&admin;
572		}
573		exit;
574		} elsif ($mode eq 'user') {
575		&user;
576		exit;
577		} elsif ($mode eq 'download') {
578		my $file = param('file');
579		$file =~ s/ /+/g; # +??????????????A????? if (! -e join('/',param('dir'),$file)) {
580		&error('?G???[',qq(?t?@?C??") . &url_decode(${file}) . qq("????????B???????\\????????B));
581		}
582		print "Content-type: application/octet-stream\n";
583		print "Content-Disposition: attachment; filename=" . &url_decode(param('file')) . "\n\n";
584		binmode(STDOUT);
585		open(IN,join('/',param('dir'),$file)) \|\| die;
586		binmode(IN);
587		# ?????????????o??????X(ver.1.82)
588		while (read IN, my $buf, 4096) {
589		print $buf;
590		}
591		close(IN);
592
593		# ?_?E?????[?h??????[?????M
594		if ($send_dlmail && param('time')) {
595		&send_dlmail;
596		}
597
598		# ?_?E?????[?h?????\?????t?@?C???????
599		if ($show_dl_count && $file !~ /_count$/) {
600		open(CNT,'>>' . join('/',param('dir'),$file . '_count')) \|\| die;
601		print CNT '1';
602		close(CNT);
603		# ???_?E?????[?h????_?E?????[?h????t?@?C????J?E???g?t?@?C????????? $max_down{"$id"} = $max_dl_count if ! $max_down{"$id"} \|\| param('dir') =~ /$user_root2/;
604		if ((stat(join('/',param('dir'),$file . '_count')))[7] >= $max_down{"$id"}) {
605		unlink join('/',param('dir'),$file);
606		unlink join('/',param('dir'),$file . '_count');
607		# unlink join('/',param('dir'),$file . '_' . param('time') . '_count') if param('time');
608		# } elsif (param('time')) {
609		# open(CNT,'>>' . join('/',param('dir'),$file . '_' . param('time') . '_count')) \|\| die;
610		# print CNT '1';
611		# close(CNT);
612		}
613		}
614		exit;
615		}
616		if ($current_dir) { $updir = $current_dir; }
617		$free_mode = 0 if ! $administrator; # ??????????O?C????????free_mode???
618		if ($free_mode) {
619		$updir = File::Spec->rel2abs($updir);
620		$updir =~ s/\\/\//g;
621		}
622		if ($subdir eq '..') {
623		# ?e?f?B???N?g????????????p?X????????????
624		$updir =~ s/[^\/]*$//;
625		} else {
626		$updir = join('/',$updir,$subdir) if $subdir;
627		}
628		if ($subdir eq '..' && index($updir,$root) < 0 && ! $free_mode) {
629		# /????????????????A?b?v???[?h?????[?g?f?B???N?g????????????????????[?g?f?B???N?g??????B
630		$updir = $root;
631		$subdir = '';
632		}
633		$updir =~ s/\/+$//; # ?????X???b?V????t???????????
634
635		# ?f?B???N?g?????????????_?C???N?g???my $url_id = &url_encode($id);
636		if ($subdir) {
637		my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
638		my $jump = qq($script) . &url_param(%param);
639		if ($post_only) {
640		my $param = \%param;
641		&jump($param);
642		} else {
643		$jump =~ s/&/&/g;
644		&redirect($jump);
645		}
646		exit;
647		}
648
649		# URL??????????????e?f?B???N?g???????????????_?C???N?g
650		if (! $free_mode && index($updir,$root) < 0) {
651		$updir = $root;
652		my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'show_size'=>$show_size);
653		my $jump = qq($script) . &url_param(%param);
654		if ($post_only) {
655		my $param = \%param;
656		&jump($param);
657		} else {
658		&redirect($jump);
659		}
660		exit;
661		}
662		my $del_com;
663		my @user_perm = &perm_list($usr_perm);
664		if ($mode eq 'move' && ($user_perm[0] \|\| $administrator) && ! $tpass && ! $login_guest) {
665		&move_file;
666		}
667		if ($mode eq 'delete') {
668		if ($user_perm[1] \|\| $administrator) {
669		&delete_file;
670		} else {
671		&error('?G???[','?????????????????);
672		}
673		}
674		if ($mode eq 'permission' && ($user_perm[2] \|\| $administrator)) {
675		if ($user_perm[2] \|\| $administrator) {
676		&permission;
677		} else {
678		&error('?G???[','?????????????????);
679		}
680		}
681		my $upfile;
682		if (param('makedir') eq '?f?B???N?g????? && $newdir) {
683		# ??p????????? $newdir =~ s/ /_/g;
684		my $new_dir_path = join('/',$updir,$newdir);
685		if (mkdir $new_dir_path) {
686		if ($make_index) {
687		open(INDEX,">" . join('/',$new_dir_path,'index.html') );
688		close(INDEX);
689		}
690		$comment .= qq(<span style="color:blue"><strong>$new_dir_path</strong>????????/span><br />);
691		} else {
692		$comment .= qq(<span style="color:red"><strong>$new_dir_path</strong>????????????/span><br />);
693		}
694		}
695		foreach (@user) {
696		my ($time,$name,$dir,$epass,$permit,$l_size,$mail,$max_day,$max_down,$dlmail) = split(/\,/);
697		$name = &rechange($name);
698		$max_day{"$name"} = $max_day if ! $login_guest;
699		$max_down{"$name"} = $max_down if ! $login_guest;
700		$dlmail{"$name"} = $dlmail;
701		my $c_dir = param('dir');
702		$c_dir = $updir if ! $c_dir;
703		my $user_root2 = $root;
704		if ($dir ne $user_root && $dir =~ /$user_root/ && $c_dir =~ /$dir/) {
705		$title .= ' (' . $name . ')??p?f?B???N?g??';
706		$dir_owner = $name;
707		$regist_user = 1;
708		last;
709		}
710		}
711		if ($mode eq 'send_url') {
712		&send_url;
713		exit;
714		}
715
716		# ???O?C???????[?????M??I???????A???[??????M???if (param('regist_mail')) {
717		&regist_mail;
718		}
719
720		my $dir1 = $updir;
721		my $dir2 = my $link1 = '';
722		$dir1 =~ s/(^$root)//;
723		$dir2 .= $1;
724		my %param = ('dir'=>$dir2,'login_user'=>$login_user,'sort'=>$sort,'show_size'=>$show_size);
725		while ($dir1 =~ s/(^\/?[^\/]+)//) {
726		$dir2 .= $1;
727		if (!-d $dir2) {
728		my $message = $dir2 . qq(????????B);
729		my $jump = $script . &url_param(%param) . qq(&message=) . &url_encode($message);
730		$jump =~ s/&/&/g;
731		&redirect($jump);
732		exit;
733		}
734		$param{'dir'} = $dir2;
735		}
736
737		my $submit = 1;
738		$submit = 2 if param('up');
739		&header();
740		my ($mail_title, $msg, $files);
741		for (my $i=1;$i<=$upnmb;$i++) {
742		if ($upfile = param('upfile' . $i)) {
743		my ($result,$size,$sec,$msec) = &file_upload($updir,$i); # $result(0:???s 1:?A?b?v???[?h???2:????A?b?v???[?h???
744		if ($encode_lib == 1) {
745		eval 'use Jcode;';
746		Jcode::convert(\$upfile, "euc"); # ?t?@?C???????????????????????????uc????B?t?@?C????????jis????B
747		} else {
748		require 'jcode.pl';
749		&jcode::convert(\$upfile, "euc"); # ?t?@?C???????????????????????????uc????B?t?@?C????????jis????B
750		}
751		$upfile =~ /([^\\\/]*)$/;
752		my $file_name = $1; # /????????~??t?@?C????????? if ($encode_lib == 1) {
753		Jcode::convert(\$file_name, "sjis","euc"); # Jcode::convert(\$file_name, "sjis");???????????? } else {
754		&jcode::convert(\$file_name, "sjis");
755		}
756		my $size_com = &kiro_byte($size);
757		my $time_com;
758		$time_com = "(?v???nbsp;" . &time_format($sec,$msec) . ')' if $show_process_time;
759		if ($result == 2) {
760		$comment .= qq(<span style="color:blue"><strong>) . $file_name . qq(</strong> $$size_com$ ??????A?b?v???[?h?????B$time_com</span><br />);
761		} elsif ($result == 1) {
762		$comment .= qq(<span style="color:blue"><strong>) . $file_name . qq(</strong> $$size_com$ ??A?b?v???[?h?????B$time_com</span><br />);
763		} elsif (! $result) {
764		$comment .= qq(<span style="color:red"><strong>) . $file_name . qq(</strong>??A?b?v???[?h?????????B$err_comment</span><br />);
765		}
766		last if ! $result; # ?A?b?v???[?h???s????A???[?v?????A?b?v???[?h????f
767		if ($result) {
768		$files .= $file_name . " ($size_com)\n";
769		}
770		}
771		}
772		if ($show_process_time && $files) {
773		$comment = qq(<span style="color:blue">?f?[?^???M ?E?E?E?E?E$) . &time_format(($prm_sec - $start_sec),($prm_msec - $start_msec)) . qq($</span><br />) . $comment;
774		}
775
776		# ?A?b?v???[?h?????l???m????????
777		if ($mail_notify && $files && @admin_mail) {
778		&upload_notify;
779		}
780		if ($user_perm[0] \|\| $administrator) {
781		$submit = 1;
782		dispform();
783		}
784		if ($login_guest) {
785		$root = param('dir');
786		}
787		my $pre_size = &size_measure("$root"); # ???[?U?[????[?g?f?B???N?g????e??print qq(<div style="margin-left:0.5em;margin-top:0.5em">\n);
788		$dir1 = $updir;
789		$dir2 = '';
790		$dir1 =~ s/(^$root)//;
791		$dir2 .= $1;
792		$param{'dir'} = $dir2;
793		$param{'tpass'} = $tpass if $tpass;
794		$param{'login_guest'} = $login_guest if $login_guest;
795		$param{'login_user'} = $login_user if $login_user;
796		$param{'login_admin'} = $login_admin if $login_admin;
797		$param{'time'} = param('time') if param('time');
798		if ($post_only) {
799		$link1 .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$1" title="$param{'dir'}???? /></form></td>);
800		} else {
801		$link1 .= qq(<a href="$script) . &url_param(%param) . qq(">$1</a>);
802		}
803		while ($dir1 =~ s/(^\/?[^\/]+)//) {
804		$dir2 .= $1;
805		$param{'dir'} = $dir2;
806		if ($1 ne '.') {
807		if ($post_only) {
808		$link1 .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$1" title="$param{'dir'}???? /></form></td>);
809		} else {
810		$link1 .= qq(<a href="$script) . &url_param(%param) . qq(">$1</a>);
811		}
812		} else {
813		$link1 .= $1;
814		}
815		}
816		if ($post_only) {
817		$link1 = qq(<table cellpadding="0" cellspacing="0" summary="?????N?\\??"><tr>$link1</tr></table>);
818		}
819		$param{'dir'} = $updir;
820		my $reload_url = &url_param(%param);
821		my $reload_hidden = &hidden_param(%param);
822		print qq(<div>\n);
823		# ?Q?X?g?A?J?E???g?????????
824		if (! $administrator && !$tpass && ! $login_guest && param('del_guest')) {
825		if (param('do_del')) {
826		if (unlink join('/',$passdir,param('dir'),param('del_guest') . '.cgi')) {
827		print qq(<span style="color:red">) . &presenttime(param('del_guest')) . qq(????A?J?E???g?????????/span> );
828		}
829		} else {
830		my $mail;
831		if (open(PAS,join('/',$passdir,param('dir'),param('del_guest') . '.cgi'))) {
832		my $line = <PAS>;
833		close(PAS);
834		$mail = (split(/<>/,$line))[3];
835		chomp $mail;
836		$mail .= '????M???br>' if $mail;
837		}
838		$mail = '' if $sample;
839		print qq(<table summary="?A?J?E???g???"><tr><td>$mail) . &presenttime(param('del_guest')) . qq(????A?J?E???g?????????H</td>);
840		my %param = ('dir'=>$updir,'login_user'=>$login_user,'del_guest'=>param('del_guest'),'do_del'=>'1');
841		if ($post_only) {
842		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?????? /></form></td></tr></table>\n);
843		} else {
844		print qq(<td><a href="$script) . &url_param(%param) . qq(">??????/a></td></tr></table>\n);
845		}
846		}
847		}
848		print qq(<table cellpadding="2" border="0" cellspacing="0" summary="?????[?h???><tr>\n);
849		if ($post_only) {
850		print qq(<td><form action="$script" method="post" style="margin:0; padding:0">$reload_hidden<table summary="?????[?h"><tr><td><input type="image" src="./img/reload.gif" alt="?????[?h" /></td><td><input type="submit" value="?????[?h" /></td></tr></table></form>\n);
851		} else {
852		print qq(<td><a href="$script$reload_url"><img src="./img/reload.gif" alt="?????[?h" border="0" /></a></td><td><a href="$script$reload_url">?????[?h</a>\n);
853		}
854		if ($administrator) {
855		if (! param('show_all')) {
856		$param{"show_all"} = 1;
857		print qq( <a href="$script) . &url_param(%param) . qq(">?B??t?@?C????\\??</a>);
858		$param{"show_all"} = 0;
859		} else {
860		$param{"show_all"} = 0;
861		print qq( <a href="$script) . &url_param(%param) . qq(">?B??t?@?C????\\??????/a>);
862		$param{"show_all"} = 1;
863		}
864		}
865		my ($user_name, $user_mail);
866		foreach (keys %mail) {
867		if ($_ && $mail{"$_"}) {
868		$user_name = $_;
869		$user_mail = $mail{"$_"};
870		}
871		}
872		# ???[?U?[?????A???[???t?H?[????\?????if ($login_user) {
873		my %param = ('mode'=>'send_url','dir'=>$updir,'login_user'=>$login_user);
874		my $mail = qq($script) . &url_param(%param);
875		if ($post_only) {
876		print qq(</td>\n<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/mail.gif" alt="???[?????M" /></form></td>);
877		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???[?????M" /></form>\n);
878		} else {
879		print qq(</td>\n<td><a href="$mail"><img src="./img/mail.gif" alt="???[?????M" border="0" /></a></td><td><a href="$mail">???[?????M</a>  \n);
880		}
881		my $pass_dir = join('/',$passdir,$updir);
882		my $guest_count = 0;
883		my (@guest_list,@kigen,@mail);
884		if (opendir(DIR,$pass_dir)) {
885		while (my $file = readdir(DIR)) {
886		if ($file =~ /(\d{10})\.cgi/) {
887		$guest_list[$guest_count] = $1;
888		open(PAS,join('/',$pass_dir,$file));
889		my $line = <PAS>;
890		close(PAS);
891		my $kikan = (split(/<>/,$line))[2];
892		if ($kikan ne 'p') {
893		$kigen[$guest_count] = $guest_list[$guest_count] + $kikan * 3600 * 24;
894		if ($kigen[$guest_count] < time) {
895		# ?L????????Q?X?g?p?p?X???h?t?@?C????????? unlink join('/',$pass_dir,$file);
896		next;
897		}
898		} else {
899		$kigen[$guest_count] = 0;
900		}
901		$mail[$guest_count] = (split(/<>/,$line))[3];
902		chomp $mail[$guest_count];
903		$mail[$guest_count] .= qq(????M) if $mail[$guest_count];
904		$guest_count++;
905		}
906		}
907		closedir(DIR);
908		}
909		# ?Q?X?g?A?J?E???g?\??
910		for (my $count=0; $count < $guest_count; $count++) {
911		my %param = ('dir'=>$updir,'login_user'=>$login_user,'del_guest'=>$guest_list[$count]);
912		my $opc = (int(($kigen[$count] - time) / ($kigen[$count] - $guest_list[$count]) * 100) / 100) + 0.1;
913		$opc = 1 if $opc > 1;
914		my $img_style = qq( style="filter:alpha$opacity=) . int($opc * 100) . qq($; -moz-opacity: $opc; opacity: $opc;");
915		my $del_link = &url_param(%param);
916		if (! $kigen[$count]) {
917		my $com = qq(?Q?X?g?A?J?E???g$guest_list[$count]\n?????;
918		$com .= qq(\n$mail[$count]) if $mail[$count] && ! $sample;
919		if ($post_only) {
920		print qq(</td>\n<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/men.gif" alt="$com" /></form>);
921		} else {
922		print qq(</td>\n<td><a href="$del_link" title="$com"><img border="0" src="./img/men.gif" alt="$com" /></a>);
923		}
924		} else {
925		my $com = qq(?Q?X?g?A?J?E???g$guest_list[$count]\n) . &presenttime($kigen[$count]) . qq(???L??;
926		$com .= qq(\n$mail[$count]) if $mail[$count] && ! $sample;
927		if ($post_only) {
928		print qq(</td>\n<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/men.gif" alt="$com"$img_style /></form>);
929		} else {
930		print qq(</td>\n<td><a href="$del_link" title="$com"><img border="0" src="./img/men.gif" alt="$com"$img_style /></a>);
931		}
932		}
933		}
934		print qq(</td>\n<td>  <a href="urlhelp.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="?w???v" />?w???v</a>);
935		}
936		print qq(</td></tr>\n);
937		print qq(</table>\n);
938		my $style= ' style="font-size:80%"';
939		if ($usr_max_size && $pre_size > $usr_max_size) {
940		$style = qq( style="font-size:80%;font-weight:bold;color:red");
941		} elsif ($usr_max_size && $pre_size / $usr_max_size > 0.8) {
942		$style = qq( style="font-size:80%;color:#dd2200");
943		}
944
945		# ?Q?X?g??????if (! $tpass && ! $login_guest) {
946		print qq(<table cellpadding="0" summary="?f?B???N?g????e????><tr><td>);
947		print qq( </td><td>);
948		if (! $show_size) {
949		$param{'show_size'} = 1;
950		if ($post_only) {
951		print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g????e???\\??" /></form> );
952		} else {
953		print qq(<a href="$script) . &url_param(%param) . qq(" title="?f?B???N?g?????t?@?C?????????\\????????????????????>?f?B???N?g????e???\\??</a> );
954		}
955		} else {
956		$param{'show_size'} = 0;
957		if ($post_only) {
958		print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g????e????\\??" /></form> );
959		} else {
960		print qq(<a href="$script) . &url_param(%param) . qq(">?f?B???N?g????e????\\??</a> );
961		}
962		}
963		print qq(<span$style>\(???e?? . &kiro_byte($pre_size);
964		print qq( / ???e?? . &kiro_byte($usr_max_size) if $usr_max_size;
965		print qq( ?t?@?C??????${file_nmb}?? if $show_size;
966		print qq( ?f?B???N?g??????${dir_nmb}?? if $show_size && $dir_nmb;
967		print qq(\)</span>);
968		print qq(</td></tr></table>\n);
969		} elsif ($tpass \|\| $login_guest) {
970		print qq(<span$style>\(???e?? . &kiro_byte($pre_size);
971		print qq( / ???e?? . &kiro_byte($usr_max_size) if $usr_max_size;
972		print qq( ?t?@?C??????${file_nmb}?? if $show_size;
973		print qq( ?f?B???N?g??????${dir_nmb}?? if $show_size && $dir_nmb;
974		print qq(\)</span>);
975		}
976		# ???[?g?f?B???N?g???????????
977		if ($free_mode) {
978		eval 'use File::Spec;';
979		my $path = File::Spec->rel2abs($dir2);
980		$path =~ s/\\/\//g;
981		my (@link,$dir,$links,$last_dir);
982		$dir = $last_dir = $path;
983		while ($dir =~ s/(\/[^\/]+$)//) {
984		my $link = qq($script?dir=$last_dir&login_admin=$login_admin);
985		$last_dir = $dir;
986		$links = qq(<a href="$link">$1</a>) . $links;
987		}
988		$links = $dir . $links;
989		print qq(<span id="path" style="font-weight:bold;">$links</span>\n);
990		} else {
991		print qq(<div id="path" style="font-weight:bold;">$link1</div>\n) if !$tpass && ! $login_guest;
992		}
993		print qq(<span style="color:red">) . param('message') . "</span>\n" if param('message');
994		print qq(</div>\n);
995		print $del_com; # ?????\??
996		print qq(<div style="margin:0.3em">$comment</div>\n) if $comment; # ??????\??
997
998		# ????????u??f?B???N?g????v??\?????if (($updir ne $root && !$tpass && ! $login_guest) \|\| $free_mode) {
999		my %param = ('dir'=>$updir,'subdir'=>'..','login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1000		if ($post_only) {
1001		print qq(<form action="$script" method="post" style="margin:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/up.gif" alt="??f?B???N?g???? /></form>\n);
1002		} else {
1003		print qq(<a href="$script) . &url_param(%param) . qq(" title="??f?B???N?g????><span style="position:relative;top:4px;"><img src="./img/up.gif" style="border-width:0" alt="??f?B???N?g???? /></span></a>\n);
1004		}
1005		if ($free_mode) {
1006		$updir = File::Spec->rel2abs($updir);
1007		$updir =~ s/\\/\//g;
1008		}
1009		}
1010		opendir(UPD,$updir);
1011		my (%pm, %size, %mod, %ind, %dir, %decode_name, %download);
1012		while (my $file = readdir(UPD)) {
1013		next if $file eq '.' \|\| $file eq '..';
1014		my $dm;
1015		($dm,$dm,$pm{"$file"},$dm,$dm,$dm,$dm,$size{"$file"},$dm,$mod{"$file"},$ind{"$file"},$dm) = stat(join('/',$updir,$file));
1016		$decode_name{"$file"} = &url_decode($file);
1017		# ?f?B???N?g??????
1018		if (-d join('/',$updir, $file)) {
1019		$dir{"$file"} = 1;
1020		$download{"$file"} = -1;
1021		$size{"$file"} = &size_measure(join('/',$updir, $file)) if $show_size;
1022		}
1023		# ?_?E?????[?h?J?E???g?t?@?C??????
1024		if ($file =~ /_count$/) {
1025		my $file_ = $file;
1026		$file_ =~ s/_count$//;
1027		if (-e join('/',$updir,$file_)) {
1028		$download{"$file_"} = $size{"$file"};
1029		}
1030		} else {
1031		$download{"$file"} = -1;
1032		}
1033		}
1034		closedir(UPD);
1035		my $index = join('/',$updir,'index.html');
1036		if ($make_index && ! -f $index) {
1037		open(INDX,">$index");
1038		close(INDX);
1039		}
1040		my @file_list = ();
1041		if ($sort eq 'name') {
1042		foreach my $key (sort { $decode_name{$a} cmp $decode_name{$b} } keys %decode_name) {
1043		push(@file_list,$key);
1044		}
1045		} elsif ($sort eq 'name_u') {
1046		foreach my $key (sort { $decode_name{$b} cmp $decode_name{$a} } keys %decode_name) {
1047		push(@file_list,$key);
1048		}
1049		} elsif ($sort eq 'time' \|\| !$sort) {
1050		foreach my $key (sort { $mod{$b} <=> $mod{$a} } keys %mod) {
1051		push(@file_list,$key);
1052		}
1053		} elsif ($sort eq 'time_u') {
1054		foreach my $key (sort { $mod{$a} <=> $mod{$b} } keys %mod) {
1055		push(@file_list,$key);
1056		}
1057		} elsif ($sort eq 'size') {
1058		foreach my $key (sort { $size{$b} <=> $size{$a} } keys %size) {
1059		push(@file_list,$key);
1060		}
1061		} elsif ($sort eq 'size_u') {
1062		foreach my $key (sort { $size{$a} <=> $size{$b} } keys %size) {
1063		push(@file_list,$key);
1064		}
1065		} elsif ($sort eq 'dl') {
1066		foreach my $key (sort { $download{$b} <=> $download{$a} } keys %download) {
1067		push(@file_list,$key);
1068		}
1069		} elsif ($sort eq 'dl_u') {
1070		foreach my $key (sort { $download{$a} <=> $download{$b} } keys %download) {
1071		push(@file_list,$key);
1072		}
1073		}
1074
1075		print qq(<table cellpadding="2" border="0" summary="?f?B???N?g????\\??">\n);
1076		my $show_file;
1077		foreach (@file_list) {
1078		if (! ($administrator && $free_mode) && ! param('show_all')) {
1079		# ?\?????t?@?C??????????? next if $_ eq $htaccess;
1080		next if $_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7]; # ?T?C?Y????ndex.html??\??????B
1081		next if $_ =~ /(_count)$/;
1082		}
1083		$show_file = 1 ;
1084		}
1085		if ($show_file) {
1086		my (%sort,%order);
1087		foreach ('name','time','size','dl') {
1088		if ($sort eq $_) {
1089		$sort{"$_"} = $_ . '_u';
1090		$order{"$_"} = '(??)';
1091		} else {
1092		$sort{"$_"} = $_;
1093		$order{"$_"} = '(?~?';
1094		}
1095		}
1096		my %param = ('dir'=>$updir,'sort'=>$sort,'show_size'=>$show_size,);
1097		$param{"tpass"} = $tpass if $tpass;
1098		$param{"login_guest"} = $login_guest if $login_guest;
1099		$param{"login_user"} = $login_user if $login_user;
1100		$param{"login_admin"} = $login_admin if $login_admin;
1101
1102		$param{"time"} = param('time') if param('time');
1103		$param{'sort'} = $sort{'name'};
1104		if ($post_only) {
1105		print qq(<tr>\n<th abbr="?C???f?b?N?X?\\?[?g" colspan="2"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?t?@?C???? title="?t?@?C?????\\?[?g$order{'name'}" /></form></th>\n);
1106		} else {
1107		print qq(<tr>\n<th abbr="?C???f?b?N?X?\\?[?g" colspan="2"><a href="$script) . &url_param(%param) . qq(" title="?t?@?C?????\\?[?g$order{'name'}">?t?@?C????/a></th>\n);
1108		}
1109		$param{'sort'} = $sort{'time'};
1110		if ($post_only) {
1111		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?X?V???" title="?X?V?????\\?[?g$order{'time'}" /></form></th>\n);
1112		} else {
1113		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><a href="$script) . &url_param(%param) . qq(" title="?X?V?????\\?[?g$order{'time'}">?X?V???</a></th>\n);
1114		}
1115		$param{'sort'} = $sort{'size'};
1116		if ($post_only) {
1117		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?T?C?Y" title="?T?C?Y??\\?[?g$order{'size'}" /></form></th>\n);
1118		} else {
1119		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><a href="$script) . &url_param(%param) . qq(" title="?T?C?Y??\\?[?g$order{'size'}">?T?C?Y</a></th>\n);
1120		}
1121		$param{'sort'} = $sort{'dl'};
1122		if ($post_only) {
1123		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="DL" title="DL????\\?[?g$order{'dl'}" /></form></th>\n) if $show_dl_count;
1124		} else {
1125		print qq(<th abbr="?C???f?b?N?X?\\?[?g"><a href="$script) . &url_param(%param) . qq(" title="DL????\\?[?g$order{'dl'}">DL</a></th>) if $show_dl_count;
1126		}
1127		print qq(<th abbr="?C???f?b?N?X">???/th>);
1128		print qq(<td> </td><td> </td>);
1129		print qq(</tr>\n);
1130		} else {
1131		my $colspan = 5;
1132		$colspan++ if $show_dl_count;
1133		print qq(<tr><td colspan="$colspan"><span style="color:gray">?????????/span></td></tr>\n);
1134		}
1135		foreach (@file_list) {
1136		my $hidden_file;
1137		if (! ($administrator && $free_mode) && ! param('show_all')) {
1138		# ?\??????t?@?C????X?L?b?v?@?t???[???[?h?????????t?@?C????\?????B
1139		next if $_ eq $htaccess;
1140		next if $_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7]; # ?T?C?Y????ndex.html??\??????B
1141		next if $_ =~ /_count$/;
1142		} else {
1143		if ($_ eq $htaccess \|\| ($_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7]) \|\| $_ =~ /_count$/) {
1144		$hidden_file = 1;
1145		}
1146		}
1147		my ($tsec, $tmin, $thour, $tmday, $tmon, $tyear)=localtime($mod{"$_"});
1148		$tyear+=1900;
1149		$tmon++;
1150		my $size = &kiro_byte($size{"$_"});
1151		my $decode_name = &url_decode($_);
1152		my $link = $_;
1153		$link =~ s/%/%25/g;
1154		my $time_str = sprintf("%02d?N%02d??02d??02d:%02d",$tyear,$tmon,$tmday,$thour,$tmin);
1155		my $img = &icon($link);
1156		my $perm = sprintf("%o", $pm{"$_"} % 512);
1157		my $move_link = " ";
1158		my %param = ('dir'=>$updir,'sort'=>$sort,'show_size'=>$show_size,'file'=>$_);
1159		$param{'tpass'} = $tpass if $tpass;
1160		$param{'login_guest'} = $login_guest if $login_guest;
1161		$param{'login_user'} = $login_user if $login_user;
1162		$param{'login_admin'} = $login_admin if $login_admin;
1163		$param{'time'} = param('time') if param('time');
1164		if (!$tpass && ! $login_guest && ($user_perm[0] \|\| $administrator)) {
1165		$param{'mode'} = 'move';
1166		if ($post_only) {
1167		$move_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="??? /></form>\n);
1168		} else {
1169		$move_link = qq(<a href="$script) . &url_param(%param) . qq(">???/a>);
1170		}
1171		}
1172		my $del_link = " ";
1173		if ($user_perm[1] \|\| $administrator) {
1174		$param{'mode'} = 'delete';
1175		if ($dir{"$_"}) {
1176		$param{'file_type'} = 'd';
1177		} else {
1178		$param{'file_type'} = 'f';
1179		}
1180		if ($post_only) {
1181		$del_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???" /></form>\n);
1182		} else {
1183		$del_link = qq(<a href="$script) . &url_param(%param) . qq(">???</a>);
1184		}
1185		}
1186		if ($user_perm[2] \|\| $administrator) {
1187		$param{'mode'} = 'permission';
1188		$param{'file_path'} = join('/',$updir,$link);
1189		if ($post_only) {
1190		$perm = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$perm" /></form>\n);
1191		} else {
1192		$perm = qq(<a href="$script) . &url_param(%param) . qq(">$perm</a>);
1193		}
1194		}
1195		if ($dir{"$_"}) {
1196		if (!$tpass && ! $login_guest) {
1197		my $size;
1198		if ($show_size) {
1199		$size = &kiro_byte(&size_measure(join('/',$updir,$link)));
1200		} else {
1201		$size = " ";
1202		}
1203		print qq(<tr>\n);
1204		my %param = ('dir'=>$updir,'subdir'=>$_,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size,'file'=>$_);
1205		if ($post_only) {
1206		print qq(<td align="right"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/dir.gif" alt="${decode_name}???? /></form></td>\n);
1207		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$decode_name" style="text-align:left;" /></form></td>\n);
1208		} else {
1209		print qq(<td align="right"><a href="$script) . &url_param(%param) . qq("><img src="./img/dir.gif" alt="$decode_name" style="border-width:0" /></a></td>\n);
1210		print qq(<td><a href="$script) . &url_param(%param) . qq(">$decode_name</a></td>\n);
1211		}
1212		print qq(<td><span style="font-size:80%">$time_str</span></td>\n<td style="text-align:right;"><span style="font-size:80%">$size</span></td>\n);
1213		print qq(<td> </td>) if $show_dl_count;
1214		print qq(<td style="text-align:center;"><div style="font-size:80%">$perm</div></td>\n);
1215		print qq(<td>$move_link</td>\n<td>$del_link</td>\n);
1216		print qq(</tr>\n);
1217		}
1218		} else {
1219		my $download = join('/',$updir,$link);
1220		my %param;
1221		if ($administrator) {
1222		%param = ('mode'=>'download','dir'=>$updir,'file'=>$link,'login_admin'=>$login_admin);
1223		} else {
1224		%param = ('mode'=>'download','dir'=>$updir,'file'=>$link);
1225		if ($login_guest) {
1226		$param{'login_guest'} = $login_guest;
1227		$param{'time'} = param('time');
1228		} elsif ($login_user) {
1229		$param{'login_user'} = $login_user;
1230		}
1231		}
1232		my $style;
1233		if ($hidden_file) {
1234		$style = qq( style="color:#777777");
1235		}
1236		if ($post_only) {
1237		my $down = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/$img" alt="${decode_name}??_?E?????[?h" /></form>);
1238		print qq(<tr><td align="right">$down</td>\n);
1239		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$decode_name" style="text-align:left;" /></form></td>\n);
1240		} else {
1241		my $down = qq($script) . &url_param(%param);
1242		print qq(<tr><td align="right"><a href="$down" title="${decode_name}??_?E?????[?h"><img src="./img/$img" alt="${decode_name}??_?E?????[?h" style="border-width:0" /></a></td>\n);
1243		print qq(<td><a href="$down" title="${decode_name}??_?E?????[?h"><span$style>$decode_name</span></a></td>\n);
1244		}
1245		print qq(<td><span style="font-size:80%">$time_str</span></td>\n<td style="text-align:right;"><span style="font-size:80%">$size</span></td>\n);
1246		if ($show_dl_count) {
1247		print qq(<td style="text-align:right;"><span style="font-size:80%">) . (stat(join('/',$updir,$_ . '_count')))[7] . qq(</span></td>\n);
1248		}
1249		print qq(<td style="text-align:center;"><span style="font-size:80%">$perm</span></td>\n);
1250		print qq(<td>$move_link</td>\n<td>$del_link</td></tr>\n);
1251		}
1252		}
1253		print qq(</table>\n</div>);
1254		my $alarm;
1255		if ($updir =~ /^$user_root/ && ! param('tpass') && ! param('login_user') && ! param('login_guest') && ! $administrator) {
1256		if (! open(RAW,join('/',$passdir,'raw_pass.cgi'))) {
1257		$alarm = 1;
1258		} else {
1259		my @raw_pass = <RAW>;
1260		close(RAW);
1261		my $rpass_ext;
1262		foreach (@raw_pass) {
1263		my ($tm, $raw_pass) = split(/\,/);
1264		my $id = param('id');
1265		if ($tm == $tm{"$id"} && $raw_pass) {
1266		$rpass_ext = 1;
1267		}
1268		}
1269		if (! $rpass_ext) {
1270		$alarm = 1;
1271		}
1272		}
1273		}
1274		if ($alarm) {
1275		print qq(<div style="margin-top:1em;background-color:#dd2222;color:#ffffff;padding-left:0.5em">?p?X???h????????/div>\n);
1276		print qq(<div style="margin:1em">??p?X???h????????????A?t?@?C????_?E?????[?h???s????\\????????B<br />\n);
1277		print qq(???????A?y?[?W?E??nbsp;<strong>???[?U?[???/strong> ?????N???strong>???[?U?[?????/strong>?????A<span style="color:red">????X????/span>?u??X?v?{?^????????????B<br />\n);
1278		print qq(<span style="color:red">?p?X???h??***???X?????B</span>??\\???????p?X???h????????????B<br />\n);
1279		print qq(<span style="color:red">????X????????B</span>??o??????????????B</div>);
1280		}
1281		# ??p?X???h???????????????L?A???[????o?????????A???????Aver.1.8?t???elp.html????
1282		unlink 'help.html' if -e 'help.html';
1283		# help.html?????????A????e??\???@???[?g?f?B???N?g???????????if ($updir eq $root && open(HTM,'help.html')) {
1284		my @html = <HTM>;
1285		close(HTM);
1286		my $start = 0;
1287		foreach (@html) {
1288		$start = 1 if index($_,'<body>') >= 0; # <body>?^?O???X?L?b?v
1289		next if ! $start \|\| index($_,'</body>') >= 0;
1290		next if index($_,'</html>') >= 0;
1291		print $_ if index($_,'<body>') < 0;
1292		}
1293		}
1294		&footer;
1295		exit;
1296
1297
1298		sub dbg {
1299		if (open(DBG,">>./debug.cgi")) {
1300		print DBG $_[0];
1301		close(DBG);
1302		}
1303		}
1304
1305
1306		# ?X?N???v?g??????????sub load_config {
1307		my %val;
1308		foreach (@config_value) {
1309		my ($name,$value) = split(/<>/);
1310		chomp $value;
1311		if ($name) {
1312		my $tmp = '$' . $name . '=\'' . $value . '\';';
1313		eval $tmp;
1314		$val{"$name"} = $value;
1315		}
1316		}
1317		@config_value = ();
1318		if (! open(SCR,"$script")) {
1319		&dbg(qq(${script}?I?[?v???G???[));
1320		return;
1321		}
1322		my ($chg_com, $config_start, $config_end);
1323		my @scr = <SCR>;
1324		close(SCR);
1325		my @new_scr = ();
1326		foreach my $line (@scr) {
1327		if ($line =~ /^# config_start/) { $config_start = 1; }
1328		if ($line =~ /^# config_end/) { $config_end = 1; }
1329		if ($config_end \|\| ! $config_start) {
1330		push(@new_scr, $line);
1331		next;
1332		}
1333		foreach my $cfg ('adminpass','passdir',@config) {
1334		if ($cfg && exists $val{"$cfg"} && $line =~ /^\s(my)?\s\$$cfg\s=\s/) {
1335		my ($value,$val);
1336		if ($val{"$cfg"} =~ /^\d+$/) {
1337		$value = $val{"$cfg"};
1338		} else {
1339		$val = $val{"$cfg"};
1340		$val =~ s/</</g;
1341		$val =~ s/>/>/g;
1342		$val =~ s/"/"/g;
1343		$val =~ s/\\$//;
1344		$value = "'" . $val . "'";
1345		}
1346		my list($frm,$com) = explode(';',$line);
1347		mylist($var,$oval) = explode('=',$frm);
1348		$oval =~ s/\s//;
1349		$oval =~ s/^['"]//;
1350		$oval =~ s/['"]$//;
1351		if ($oval ne $val{"$cfg"}) {
1352		$chg_com .= qq(${frm} ??) . 'my $' . $cfg . " = " . $value . qq(\n);
1353		}
1354		chomp $com;
1355		$line = 'my $' . $cfg . " = " . $value . ";" . $com . "\n";
1356		push(@config_value,qq($cfg<>) . $val{"$cfg"} . qq(\n));
1357		last;
1358		}
1359		}
1360		push(@new_scr, $line);
1361		}
1362
1363		# ?????O??o?b?N?A?b?v??? open(INIT,">${script}_bck.cgi") \|\| &error("${script}_bck.cgi??J?????B");
1364		print INIT @scr;
1365		close(INIT);
1366
1367		open(NEW,">$script") \|\| &error("${script}??J?????B");
1368		print NEW @new_scr;
1369		close(NEW);
1370
1371		open(CFG,">$config_file") \|\| &error("${config_file}??J?????B");
1372		print CFG @config_value;
1373		close(CFG);
1374
1375		my $message = "???????????;
1376		my $jump = qq($script?message=) . &url_encode($message);
1377		&redirect($jump);
1378		}
1379
1380
1381
1382		sub icon {
1383		my $file = $_[0];
1384		my %icon = ('gif'=>'gif.gif','jpg'=>'jpg.gif','png'=>'png.gif','bmp'=>'bmp.gif','html'=>'html.gif','htm'=>'html.gif','txt'=>'file.gif','ai'=>'ai.gif','eps'=>'ai.gif','psd'=>'psd.gif','pdf'=>'pdf.gif','zip'=>'zip.gif','wav'=>'wav.gif','avi'=>'avi.gif');
1385		my ($tail, $img);
1386		if (-d join('/',$updir,$file)) {
1387		$img = 'dir.gif';
1388		} else {
1389		$file =~ /\.([^\.]{1,4})$/;
1390		$tail = lc $1;
1391		if ($icon{"$tail"}) {
1392		$img = $icon{"$tail"};
1393		} else {
1394		$img = 'bin.gif';
1395		}
1396		}
1397		return $img;
1398		}
1399
1400
1401		sub move_file {
1402		my $encode_file = &url_encode($file);
1403		$encode_file =~ s/%2e/\./g;
1404		$title .= qq( ?\|?t?@?C??????\|);
1405		$encode_file =~ /\.(.{1,4})$/;
1406		my $tail = lc $1;
1407		if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1408		&error("${tail}?t?@?C????????F?????????B");
1409		}
1410		if ($file =~ /\.htaccess$/ && ! $user_perm[3] && ! $administrator) {
1411		&error(".htaccess?t?@?C????????F?????????B");
1412		}
1413		my @subdir_list = ();
1414		my $subdir_com = '';
1415		if (! $target) {
1416		opendir(DIR,$updir);
1417		while(my $subdir = readdir(DIR)) {
1418		next if $subdir eq '.' \|\| ! -d join('/',$updir,$subdir);
1419		next if $subdir eq '..' && $updir eq $root;
1420		next if $subdir eq $file;
1421		push(@subdir_list,$subdir);
1422		}
1423		closedir(DIR);
1424		if (@subdir_list) {
1425		$subdir_com .= qq(<select name="target" size=") . (scalar(@subdir_list)) . qq(" tabindex="1">\n);
1426		foreach (@subdir_list) {
1427		my $ful_path;
1428		if ($_ eq '..') {
1429		$ful_path = $updir;
1430		$ful_path =~ s/\/[^\/]*$//;
1431		} else {
1432		$ful_path = join('/',$updir,$_);
1433		}
1434		$subdir_com .= qq(<option value="$_">$ful_path</option>\n);
1435		}
1436		$subdir_com .= qq(</select>\n);
1437		}
1438		&header;
1439		print qq(<div style="margin:0.5em;">\n);
1440		my $comment;
1441		$comment = qq(<strong>) . join('/',$updir,$file) . qq(</strong>??????w????????B);
1442		$comment .= qq(<br />????t?@?C???A?T?u?f?B???N?g?????????????B) if -d join('/',$updir,$file);
1443		print qq(<table summary="???R?????g"><tr><td valign="top"><img src="./img/) . &icon($file) . qq(" alt="$file" /></td><td align="left">$comment</td></tr></table>\n);
1444		if (@subdir_list) {
1445		my $show_size = param('show_size');
1446		my $sort = param('sort');
1447		my %param = ('mode'=>'move','move'=>'do','dir'=>$updir,'file'=>$file,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1448		if (-d join('/',$updir,$file)) {
1449		$param{'file_type'} = 'd';
1450		} else {
1451		$param{'file_type'} = 'f';
1452		}
1453		my $hidden = &hidden_param(%param);
1454		print <<"EOF" ;
1455		<form action="$script" method="post" style="margin:0.5em">
1456		$hidden
1457		<table summary="?f?B???N?g???I??>
1458		<tr><td>
1459		$subdir_com
1460		</td>
1461		<td valign="top">
1462		<input type="submit" value="????? tabindex="2" />
1463		<input type="submit" value="?L?????Z??" onclick="history.back(); return false;" tabindex="3" />
1464		</td></tr>
1465		</table>
1466		</form>
1467		EOF
1468		} else {
1469		print qq(???????????B<input type="submit" value="??? onclick="history.back(); return false;" />\n);
1470		}
1471		print qq(</div>\n);
1472		&footer;
1473		exit;
1474		}
1475		my $original_path = join('/',$updir, $encode_file);
1476		my $target_dir = join('/',$updir, $target);
1477		if ($target eq '..') {
1478		$target_dir = $updir;
1479		$target_dir =~ s/\/[^\/]*$//;
1480		}
1481		my $target_path = join('/',$target_dir,$encode_file);
1482
1483		use File::Copy;
1484
1485		if (param('file_type') eq 'd') {
1486		$original_path = &url_decode($original_path);
1487		}
1488		if (param('file_type') eq 'd') {
1489		$target_path = &url_decode($target_path);
1490		}
1491		if (move $original_path, $target_path) {
1492		if (-e $original_path . '_count') {
1493		move $original_path . '_count', $target_path . '_count';
1494		}
1495		$original_path = &url_decode($original_path);
1496		$target_path = &url_decode($target_path);
1497		$del_com = qq(<div style="color:blue">${original_path}???{target_path}????????B</div>);
1498		} else {
1499		$del_com = qq(<div style="color:red">${original_path}????????????B\$original_path=$original_path \$target_path=$target_path</div>);
1500		}
1501		}
1502
1503
1504		sub delete_file {
1505		my $encode_file;
1506		if (param('file_type') eq 'd') {
1507		$encode_file = $file;
1508		} else {
1509		$encode_file = &url_encode($file);
1510		}
1511		$encode_file =~ s/%2e/\./g;
1512		$title .= qq( ?\|?t?@?C???????\|);
1513		$encode_file =~ /\.(.{1,4})$/;
1514		my $tail = lc $1;
1515		if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1516		&error("${tail}?t?@?C????????F?????????B");
1517		}
1518		if ($file =~ /\.htaccess$/ && ! $user_perm[3] && ! $administrator) {
1519		&error(".htaccess?t?@?C????????F?????????B");
1520		}
1521		if (! $delete_file) {
1522		&header;
1523		print qq(<div style="margin:0.5em;">\n);
1524		my $comment;
1525		if (-d join('/',$updir,$encode_file)) {
1526		$comment = qq(<strong>$file</strong>?????????H????t?@?C???A?T?u?f?B???N?g??????????????B);
1527		} else {
1528		$comment = qq(<strong>$file</strong>?????????H);
1529		}
1530		print qq(<table summary="????m?F?{?^??"><tr><td><img src="./img/) . &icon($file) . qq(" alt="$file" /></td><td>$comment</td></tr></table>\n);
1531		my $show_size = param('show_size');
1532		my $time = param('time');
1533		my %param = ('mode'=>'delete','delete_file'=>'do','dir'=>$updir,'file'=>$file,'file_type'=>param('file_type'),'login_guest'=>$login_guest,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size,'time'=>$time);
1534		my $hidden = &hidden_param(%param);
1535		print <<"EOF";
1536		<form action="$script" method="post" style="margin:0.5em">
1537		$hidden
1538		<input type="submit" value="?????? tabindex="1" />
1539		<input type="submit" value="?L?????Z??" onclick="history.back(); return false;" tabindex="2" />
1540		</form>
1541		</div>
1542		EOF
1543		&footer;
1544		exit;
1545		}
1546		my $del_path = join('/',$updir, $encode_file);
1547		if (-d $del_path) {
1548		&delete_dir($del_path);
1549		my $tmpdir = join('/',$updir, $encode_file);
1550		$tmpdir =~ s/^\.\///;
1551		$tmpdir = join('/',$passdir,$tmpdir);
1552		&delete_dir($tmpdir); # ?p?X???h???f?B???N?g??????
1553		$del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>?????????B</div>";
1554		} elsif (-e $del_path) {
1555		if (unlink $del_path) {
1556		$del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>?????????B</div>";
1557		} else {
1558		$del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>?????????????B$del_path</div>";
1559		}
1560		if (-e $del_path . '_count') {
1561		unlink $del_path . '_count';
1562		}
1563		} else {
1564		$del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>????????B</div>";
1565		}
1566		}
1567
1568		sub get_perm {
1569		$file_path = shift;
1570		my @st = stat($file_path);
1571		my (%mode);
1572		my ($mode) = $st[2] % 512;
1573		$mode{'o_r'} = $mode & 256;
1574		$mode{'o_w'} = $mode & 128;
1575		$mode{'o_x'} = $mode & 64;
1576		$mode{'g_r'} = $mode & 32;
1577		$mode{'g_w'} = $mode & 16;
1578		$mode{'g_x'} = $mode & 8;
1579		$mode{'u_r'} = $mode & 4;
1580		$mode{'u_w'} = $mode & 2;
1581		$mode{'u_x'} = $mode & 1;
1582		return %mode;
1583		}
1584
1585		sub permission {
1586		my $chg_perm_com;
1587		my $decode_file_name = &url_decode(${file_path});
1588		$file_path =~ /\.(.{1,4})$/;
1589		my $tail = lc $1;
1590		if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1591		&error("${tail}?t?@?C????????F?????????B");
1592		}
1593		if ($ch_mod eq '??X') {
1594		my $chmode = 0;
1595		my ($ov,$gv,$uv);
1596		foreach ('o_r','o_w','o_x','g_r','g_w','g_x','u_r','u_w','u_x',) {
1597		my $plus = 0;
1598		if (param("$_")) {
1599		$chmode += param("$_");
1600		if (/r$/) {
1601		$plus = 4;
1602		} elsif (/w$/) {
1603		$plus = 2;
1604		} elsif (/x$/) {
1605		$plus = 1;
1606		}
1607		if (/^o/) {
1608		$ov += $plus;
1609		} elsif (/^g/) {
1610		$gv += $plus;
1611		} elsif (/^u/) {
1612		$uv += $plus;
1613		}
1614		}
1615		}
1616		if (! chmod($chmode, $file_path)) {
1617		&error('?p?[?~?b?V??????X?G???[',"${file_path}??p?[?~?b?V???????X?????????B\$chmode=$chmode \$file_path=$file_path");
1618		} else {
1619		my $new_prm = (stat($file_path))[2];
1620		$new_prm = substr((sprintf "%03o", $new_prm), -3);
1621		if ($new_prm == $ov . $gv . $uv) {
1622		$chg_perm_com = qq(<span style="color:blue">${decode_file_name}??p?[?~?b?V?????? . $ov . $gv . $uv . qq(???X?????B</span>);
1623		} else {
1624		$chg_perm_com = qq(<span style="color:red">${decode_file_name}??p?[?~?b?V?????? . $ov . $gv . $uv . qq(???X?????????B</span>);
1625		}
1626		}
1627		}
1628		my (%mode) = &get_perm($file_path);
1629		foreach(keys %mode){
1630		if($mode{$_}){ $mode{$_} = qq( checked="checked");}
1631		else{ $mode{$_} = "";}
1632		}
1633		my($o_v,$g_v,$u_v);
1634		foreach ('o_r','o_w','o_x','g_r','g_w','g_x','u_r','u_w','u_x',) {
1635		my $plus;
1636		if ($mode{"$_"}) {
1637		if (/r$/) {
1638		$plus = 4;
1639		} elsif (/w$/) {
1640		$plus = 2;
1641		} elsif (/x$/) {
1642		$plus = 1;
1643		}
1644		if (/^o/) {
1645		$o_v += $plus;
1646		} elsif (/^g/) {
1647		$g_v += $plus;
1648		} elsif (/^u/) {
1649		$u_v += $plus;
1650		}
1651		}
1652		}
1653		$title .= qq( ?\|?p?[?~?b?V???????X?\|);
1654		&header;
1655		print qq(<div style="margin:1em">);
1656		my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1657		if ($post_only) {
1658		print qq(<div style="text-align:center;"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???></form></div>\n);
1659		} else {
1660		print qq(<div style="text-align:center;"><a href="$script) . &url_param(%param) . qq(">???/a></div>\n);
1661		}
1662		my $dir = param('dir');
1663		my $show_size = param('show_size');
1664		undef %param;
1665		%param = ('mode'=>'permission','dir'=>$dir,'file_path'=>$file_path,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1666		my $hidden = &hidden_param(%param);
1667		print <<"EOF";
1668		<form action="$script" method="post" style="margin:0;padding:0">
1669		$hidden
1670		<div style="text-align:center;">
1671		$chg_perm_com
1672		<div><strong>${decode_file_name}</strong>??p?[?~?b?V????</div>
1673		<table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="?p?[?~?b?V?????t?H?[??">
1674		<tr><th>?I?[?i?[</th><th>?O???[?v</th><th>????/th></tr>
1675		<tr>
1676		<td style="text-align:left;">
1677		<input type="checkbox" name="o_r" id="o_r" value="256"$mode{'o_r'} tabindex="1" /><label for="o_r">???o??4)</label><br />
1678		<input type="checkbox" name="o_w" id="o_w" value="128"$mode{'o_w'} tabindex="2" /><label for="o_w">?????2)</label><br />
1679		<input type="checkbox" name="o_x" id="o_x" value="64"$mode{'o_x'} tabindex="3" /><label for="o_x">???s(1)</label>
1680		</td>
1681		<td style="text-align:left;">
1682		<input type="checkbox" name="g_r" id="g_r" value="32"$mode{'g_r'} tabindex="4" /><label for="g_r">???o??4)</label><br />
1683		<input type="checkbox" name="g_w" id="g_w" value="16"$mode{'g_w'} tabindex="5" /><label for="g_w">?????2)</label><br />
1684		<input type="checkbox" name="g_x" id="g_x" value="8"$mode{'g_x'} tabindex="6" /><label for="g_x">???s(1)</label>
1685		</td>
1686		<td style="text-align:left;">
1687		<input type="checkbox" name="u_r" id="u_r" value="4"$mode{'u_r'} tabindex="7" /><label for="u_r">???o??4)</label><br />
1688		<input type="checkbox" name="u_w" id="u_w" value="2"$mode{'u_w'} tabindex="8" /><label for="u_w">?????2)</label><br />
1689		<input type="checkbox" name="u_x" id="u_x" value="1"$mode{'u_x'} tabindex="9" /><label for="u_x">???s(1)</label>
1690		</td>
1691		</tr>
1692		<tr>
1693		<td style="text-align:center;font-weight:bold">$o_v</td>
1694		<td style="text-align:center;font-weight:bold">$g_v</td>
1695		<td style="text-align:center;font-weight:bold">$u_v</td>
1696		</tr>
1697		<tr><td colspan="3" style="text-align:center;"><input type="submit" name="ch_mod" value="??X" tabindex="10" /> <input type="submit" value="?L?????Z??" onclick="history.back(); return false;" /></td></tr>
1698		</table>
1699		</div>
1700		</form>
1701		</div>
1702		EOF
1703		&footer;
1704		exit;
1705		}
1706
1707
1708		sub perm_list {
1709		my $permit = shift;
1710		my @perm;
1711		my $count = 0;
1712		for(my $i = 1; $i <= 8; $i *= 2){
1713		if($permit & $i){ $perm[$count] = 1; }
1714		else{ $perm[$count] = 0; }
1715		$count++;
1716		}
1717		return @perm;
1718		}
1719
1720		sub get_subdir {
1721		my $dir = shift;
1722		my @list;
1723		opendir(DIR, $dir) or return($!);
1724		while( my $file = readdir(DIR) ){
1725		next if( $file =~ /^\.{1,2}$/ );
1726		push(@list, "$dir/$file") if -d "$dir/$file";
1727		}
1728		closedir(DIR);
1729		foreach (@list) {
1730		push(@dir_list,$_);
1731		&get_subdir("$_");
1732		}
1733		}
1734
1735
1736		sub delete_dir {
1737		my $dir = shift;
1738		opendir(DIR, $dir) or return($!);
1739		my @subdir = ();
1740		while( my $file = readdir(DIR) ){
1741		next if( $file =~ /^\.{1,2}$/ );
1742		push(@subdir,$file);
1743		}
1744		closedir(DIR);
1745		foreach $file (@subdir) {
1746		if( -d "$dir/$file" ){ delete_dir("$dir/$file"); }
1747		else { unlink("$dir/$file") or return("$dir/$file"); }
1748		}
1749		rmdir($dir) or return($!);
1750		return 0;
1751		}
1752
1753		# ?A?b?v???[?h???ife_???????t?@?C??????
1754		sub delete_old {
1755		my $dir = shift;
1756		my $life_ = shift;
1757		my @list = ();
1758		opendir(DIR, $dir) or die("Can not open directory:$dir ($!)");
1759		@list = readdir(DIR);
1760		closedir(DIR);
1761		foreach my $file (sort @list){
1762		next if( $file =~ /^\.{1,2}$/ ); # '.' ??'..' ??X?L?b?v
1763		next if $file eq $htaccess \|\| $file eq 'index.html';
1764		next if $_ =~ /_count$/;
1765
1766		#-- ?f?B???N?g???????????g????o??--#
1767		if( -d "$dir/$file" ){
1768		delete_old("$dir/$file",$life_);
1769		} else {
1770		my $tm = (stat("$dir/$file"))[9];
1771		if ($tm + $life_ * 3600 * 24 < time) {
1772		unlink("$dir/$file");
1773		if (-e "$dir/$file" . '_count') {
1774		unlink("$dir/$file" . '_count');
1775		}
1776		push(@del_list,"$dir/$file");
1777		}
1778		}
1779		}
1780		}
1781
1782		# ?A?b?v???[?h?A?f?B???N?g?????t?H?[????\??
1783		sub dispform {
1784		print qq(<div style="margin-left:1em;margin-top:0.4em">\n);
1785		if ($show_process) {
1786		print qq(<form action="$script" method="post" enctype="multipart/form-data" onsubmit="open_w" style="padding:0.2em">\n);
1787		} else {
1788		print qq(<form action="$script" method="post" enctype="multipart/form-data" style="padding:0.2em">\n);
1789		}
1790		print qq(<input type="hidden" name="show_size" value="1" />) if param('show_size');
1791		print qq(<input type="submit" name= "up" value="?A?b?v???[?h" tabindex="1" />\n);
1792		if ($tpass \|\| $login_guest) {
1793		$del_day = $max_day{"$id"} if ! $del_day;
1794		if ($del_day ne 'p') {
1795		my $kigen = param('time') + $del_day * 3600 * 24;
1796		my $tmp = &presenttime($kigen);
1797		$tmp =~ s/:\d{2}$//;
1798		print qq(  ?L????nbsp;<strong>$tmp</strong>);
1799		}
1800		} else {
1801		chomp $max_day{"$dir_owner"};
1802		$max_day{"$dir_owner"} = $auto_delete if ! $max_day{"$dir_owner"};
1803		print qq(  ?t?@?C??????? <strong>$max_day{"$dir_owner"}??/strong>);
1804		}
1805		$max_down{"$dir_owner"} = $max_dl_count if ! $max_down{"$dir_owner"};
1806		print qq(  ???_?E?????[?h??? <strong>$max_down{"$dir_owner"}??/strong>) if $show_dl_count;
1807		print qq(<div>\n);
1808		for (my $i=1;$i<=$upnmb;$i++) {
1809		print qq(<input type="file" name="upfile$i" tabindex=") . ($i + 1) . qq(" style="margin-top:0.4em" />\n);
1810		}
1811		print qq(</div>\n);
1812		my $time = param('time');
1813		my $sort = param('sort');
1814		my %param = ('dir'=>$updir,'sort'=>$sort,'login_admin'=>$login_admin,'login_user'=>$login_user,'login_guest'=>$login_guest,'time'=>$time);
1815		my $hidden = &hidden_param(%param);
1816		print $hidden;
1817		print qq(</form>\n);
1818		if (! $login_guest) {
1819		print qq(<form action="$script" method="post" enctype="multipart/form-data" style="padding:0.2em">\n);
1820		print $hidden;
1821		print qq(<input type="text" name="mkdir" value="" style="ime-mode:disabled;" tabindex=") . ($upnmb + 2) . qq(" />\n);
1822		print qq(<input type="submit" name="makedir" value="?f?B???N?g????? tabindex=") . ($upnmb + 3) . qq(" />\n);
1823		print qq(</form>\n);
1824		}
1825		print qq(</div>\n);
1826		}
1827
1828		sub file_upload {
1829		my ($upload_strt_sec,$upload_strt_msec,$upload_end_sec,$upload_end_msec);
1830		($upload_strt_sec,$upload_strt_msec) = &get_microsec if $show_process_time;
1831
1832		my ($updir,$nmb) = @_;
1833		$upfile =~ /\.(.{1,4})$/;
1834		my $tail = lc $1;
1835		if ($prohibit_ext =~ /$tail/ && (! $user_perm[3] \|\| ! $login_user) && ! $administrator) {
1836		&error("${tail}?t?@?C????????F?????????B");
1837		}
1838		if ($upfile =~ /\.htaccess$/ && (! $user_perm[3] \|\| ! $login_user) && ! $administrator) {
1839		&error(".htaccess?t?@?C????????F?????????B");
1840		}
1841		my $euc_upfile = $upfile;
1842		# ?\???????????asename?????????A?????uc????????asename?????Asjis???? if ($encode_lib == 1) {
1843		eval 'use Jcode;';
1844		Jcode::convert(\$euc_upfile, "euc");
1845		} else {
1846		require 'jcode.pl';
1847		&jcode::convert(\$euc_upfile, "euc");
1848		}
1849		# my $basename = basename($euc_upfile); # web??t?@?C????????????? $euc_upfile =~ /([^\\\/]+)$/;
1850		my $basename = $1;
1851		if ($encode_lib == 1) {
1852		Jcode::convert(\$basename, "sjis","euc");
1853		} else {
1854		&jcode::convert(\$basename, "sjis","euc");
1855		}
1856		$basename = &url_encode($basename); # ??{???t?@?C??????A?b?v???[?h???????RL?G???R?[?h
1857		$basename =~ s/%2e/\./g; # .(?h?b?g)????????????A???????? $root = param('dir') if $login_guest;
1858		my $size = &size_measure("$root"); # ??p?f?B???N?g?????????e???v?? my $write;
1859		my $filepath = join('/',$updir,$basename); # ?A?b?v???[?h???t?@?C???p?X
1860		if (-e $filepath) {
1861		$write = 2; # ?A?b?v???[?h??????t?@?C??????????????b?Z?[?W??o???? } else {
1862		$write = 1;
1863		}
1864		my $up = 'upfile' . $nmb;
1865		my $fh = upload("$up");
1866		my $pre_size = (stat($fh))[7];
1867
1868		if ($pre_size > $max_file_size) {
1869		$err_comment = qq(?A?b?v???[?h???t?@?C???T?C?Y?????{max_file_mb}MB????A) . &kiro_byte($pre_size) . qq(??????B);
1870		return 0;
1871		} elsif ($usr_max_size && $pre_size + $size > $usr_max_size) {
1872		if ($usr_max_size - $size > 0) {
1873		$err_comment = qq(???e??? . &kiro_byte($usr_max_size - $size) . qq(???????A?A?b?v???[?h?t?@?C???? . &kiro_byte($pre_size) . qq(??????B);
1874		} else {
1875		$err_comment = qq(????f?B???N?g??????e??? . &kiro_byte($usr_max_size) . qq(????????B);
1876		}
1877		return 0;
1878		}
1879		if ($upload_type == 1) {
1880		if (! copy ($fh, "$filepath")) {
1881		return 0;
1882		}
1883		} else {
1884		if (open(WF, ">$filepath")) {
1885		binmode WF;
1886		while(read($upfile, my $buf, 256)){
1887		print WF $buf;
1888
1889		}
1890		close $upfile;
1891		close(WF);
1892		} else {
1893		return 0;
1894		}
1895		}
1896		($upload_end_sec,$upload_end_msec) = &get_microsec if $show_process_time;
1897		my $sec = $upload_end_sec - $upload_strt_sec if $show_process_time;
1898		my $msec = $upload_end_msec - $upload_strt_msec if $show_process_time;
1899		if ($show_dl_count) {
1900		open(CNT,">${filepath}_count");
1901		close(CNT);
1902		}
1903		if ($show_process_time) {
1904		return ($write,$pre_size,$sec,$msec);
1905		} else {
1906		return ($write,$pre_size);
1907		}
1908		}
1909
1910
1911		sub header {
1912		if ($header_flag) { return; }
1913		my $nohead = $_[0];
1914		$header_flag = 1;
1915		print "Content-type: text/html\n\n";
1916		print <<"EOM";
1917		<?xml version="1.0" encoding="Shift_JIS"?>
1918		<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1919		<html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja">
1920		<head>
1921		<meta http-equiv="content-type" content="text/html; charset=Shift_JIS" />
1922		<meta http-equiv="content-style-type" content="text/css" />
1923		<meta http-equiv="content-script-type" content="text/javascript" />
1924		<meta name="description" content="?}???`?A?b?v???[?_" />
1925		<meta name="keywords" content="?L?[???h????? />
1926		<title>$title</title>
1927		<link rel="stylesheet" href="./style.css" type="text/css" />
1928		EOM
1929		if ($show_process && $submit) {
1930		print <<"EOM";
1931		<script type="text/javascript"><!--
1932		function open_w() {
1933		wo = window.open("","upload","toolbar=no,location=no,directories=no,menubar=no,width=300,height=50");
1934		wo.document.write("<html><head><title>?A?b?v???[?h???E?E?E</title></head>");
1935		wo.document.write("<body><div><img src='./img/uploading.gif' /></div></body></html>");
1936		}
1937		function close_w() {
1938		wo = window.open("","upload");
1939		wo.close();
1940		}
1941		//--></script>
1942		EOM
1943		}
1944		print qq(</head>\n);
1945		if ($show_process && $submit == 2) {
1946		print qq(<body onLoad="close_w()">\n);
1947		} else {
1948		print qq(<body>\n);
1949		}
1950		print &headline if $nohead ne 'nohead';
1951		}
1952
1953		sub headline {
1954		my $html;
1955		my $text_color = &text_color($title_back_col);
1956		my $url_id = &url_encode($id);
1957		my $logout;
1958		if (! $error_header) {
1959		if ($id && ($login_user \|\| $login_admin)) {
1960		my $param = qq(?logout=$login_user);
1961		$param = qq(?logout=$login_admin) if $login_admin;
1962		$logout = qq(<div class="home"><a href="$script$param" style="color:$text_color;text-decoration:none;">???O?A?E?g</a>  <span style="font-size:80%;color:$text_color">?\|${id}????O?C?????\|</span></div>);
1963		} elsif ($id && ($tpass \|\| $login_guest)) {
1964		my $param = qq(?logout=$login_guest);
1965		$logout = qq(<div class="home"><a href="$script$param" style="color:$text_color;text-decoration:none;">???O?A?E?g</a>  <span style="font-size:80%;color:$text_color">?\|${id}$?Q?X?g$????O?C?????\|</span></div>);
1966		}
1967		}
1968		$html = <<"EOM";
1969		<div style="text-align:center;background-color:$title_back_col;color:$text_color;padding:0.2em 0.2em 0.2em 0.2em;font-size:$title_font_size;font-weight:bold;margin-bottom:0em"><a name="top" id="top">$title</a></div>
1970		$logout
1971		EOM
1972		if ($administrator \|\| ($user_mode && $user_regist && $regist_user)) {
1973		$html .= qq(<div class="admin">);
1974		if ($administrator) {
1975		my %param = ('mode'=>'admin','login_admin'=>$login_admin);
1976		if ($post_only) {
1977		$html .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???????? /></form>);
1978		} else {
1979		$html .= qq(<a href="$script) . &url_param(%param) . qq(" style="color:$text_color;text-decoration:none;">????????/a>\n);
1980		}
1981		} elsif ($user_mode && $user_regist && $regist_user) {
1982		my %param = ('mode'=>'user','login_user'=>$login_user);
1983		if ($post_only) {
1984		$html .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???[?U?[??? /></form>);
1985		} else {
1986		$html .= qq(<a href="$script) . &url_param(%param) . qq(" style="color:$text_color;text-decoration:none;">???[?U?[???/a>\n);
1987		}
1988		}
1989		$html .= qq(</div>\n);
1990		}
1991		return $html;
1992		}
1993
1994		sub footer {
1995		print $debug;
1996		print qq(<div style="text-align:right;margin:1em">\n);
1997		print qq(<table summary="footer" style="margin-left:auto"><tr><td>$simple_title</td>\n);
1998		my %param = ('mode'=>'history','login_guest'=>$login_guest,'login_user'=>$login_user,'login_admin'=>$login_admin);
1999		if ($post_only) {
2000		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ver.$ver" /></form></td>\n);
2001		} else {
2002		print qq(<td><a href="$script) . &url_param(%param) . qq(" title="?X?V????>ver.$ver</a></td>\n);
2003		}
2004		print qq(<td>© <a href="http://shade-search.com/sts/fsw/" target="_blank">hirayama</a></td></tr></table>\n</div>);
2005		print end_html;
2006		}
2007
2008
2009		sub text_color {
2010		my $base_color = $_[0];
2011		my $txt_color;
2012		if ($_[0] !~ /#[a-zA-Z0-9]{6}/) {
2013		return '#000000';
2014		}
2015		$base_color =~ s/#//;
2016		my $r = substr($base_color,0,2);
2017		my $g = substr($base_color,2,2);
2018		my $b = substr($base_color,4,2);
2019		my $r_hex = hex($r);
2020		my $g_hex = hex($g);
2021		my $b_hex = hex($b);
2022		my $meido = $r_hex * 0.299 + $g_hex * 0.587 + $b_hex * 0.114;
2023		if ($meido < 128) {
2024		$txt_color = '#ffffff';
2025		} else {
2026		$txt_color = '#000000';
2027		}
2028		return $txt_color;
2029		}
2030
2031		sub url_encode {
2032		my $encoded = $_[0];
2033		$encoded =~ s/([^\w ])/'%' . unpack('H2', $1)/eg;
2034		$encoded =~ tr/ /+/;
2035		return $encoded;
2036		}
2037
2038
2039		sub url_decode {
2040		my $value = $_[0];
2041		$value =~ tr/+/ /;
2042		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
2043		return $value;
2044		}
2045
2046		sub send_dlmail {
2047		my @template;
2048		if (open(TMP,'./mail_template/dl.txt')) {
2049		@template = <TMP>;
2050		close(TMP);
2051		}
2052		open(USR,'./user.cgi');
2053		my @user = <USR>;
2054		close(USR);
2055		my ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$raw_pass,$html,$dlmail,$dm);
2056		foreach (@user) {
2057		if ((split(/\,/))[1] eq $id) {
2058		($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$dm,$dm,$dlmail) = split(/\,/);
2059		chomp $dlmail;
2060		if (! $dlmail) {
2061		last;
2062		}
2063		$in_user = &rechange($in_user);
2064		last;
2065		}
2066		}
2067		return if ! $dlmail;
2068		my $guest_file = join('/',$passdir,param('dir'),param('time')) . '.cgi';
2069		my $mail_adr;
2070		if (open(GST,$guest_file)) {
2071		my $line = <GST>;
2072		close(GST);
2073		$mail_adr = (split(/<>/,$line))[3];
2074		chomp $mail_adr;
2075		}
2076		my @body;
2077		$mail_adr = param('time') if ! $mail_adr;
2078		my $now = &presenttime(time);
2079		my $msg;
2080		foreach (@template) {
2081		s/<time>/$now/g;
2082		s/<guest>/$mail_adr/g;
2083		s/<mr>/$mr/g;
2084		my $dir = param('dir');
2085		s/<dir>/$dir/g;
2086		my $dl_file = &url_decode(param('file'));
2087		s/<file>/$dl_file/g;
2088		push(@body,$_);
2089		$msg .= $_;
2090		}
2091
2092		# ???[???p?^?C?g??
2093		my $mail_title = qq(?t?@?C????_?E?????[?h??????;
2094		# MIME?G???R?[?h
2095		require './mimew.pl';
2096		my $send_to = &mimeencode(qq("${in_user}$mr" <$in_mail>));
2097		&mail($mail_title, $msg, $send_to, $mail_adr);
2098		}
2099
2100		sub send_mail {
2101		my @template;
2102		if (open(TMP,'./mail_template/a2u.txt')) {
2103		@template = <TMP>;
2104		close(TMP);
2105		}
2106		open(USR,'./user.cgi');
2107		my @user = <USR>;
2108		close(USR);
2109		open(RAW,join('/',$passdir,'raw_pass.cgi'));
2110		my @raw_pass = <RAW>;
2111		close(RAW);
2112		my ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$raw_pass,$html);
2113		foreach (@user) {
2114		if ((split(/\,/))[0] == param('tm')) {
2115		($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail) = split(/\,/);
2116		$in_user = &rechange($in_user);
2117		last;
2118		}
2119		}
2120		foreach (@raw_pass) {
2121		if ((split(/\,/))[0] == param('tm')) {
2122		$raw_pass = (split(/\,/))[1];
2123		$raw_pass = &rechange($raw_pass);
2124		last;
2125		}
2126		}
2127		if (param('send') eq '????e????M') {
2128		my ($mbody,$msg,$send_to);
2129
2130		# ???[???p?^?C?g??
2131		my $mail_title = qq(${simple_title}?o?^???m???;
2132		$msg = param('cont');
2133		$msg =~ s/&/??/g;
2134		$msg =~ s/"/?h/g;
2135		require './mimew.pl';
2136		$send_to = &mimeencode(qq("${in_user}$mr" <$in_mail>));
2137		&mail($mail_title, $msg, $send_to, $admin_mail[0]);
2138		$html .= qq(<div style="margin:1em;text-align:center;">???[??????M?????/div>\n);
2139		# ???[???t?H?[???\??
2140		} else {
2141		my $url = url;
2142		my @body;
2143		foreach (@template) {
2144		s/<cgi_title>/$simple_title/g;
2145		s/<admin_name>/$admin_name/g;
2146		s/<user_name>/$in_user/g;
2147		s/<mr>/$mr/g;
2148		s/<url>/$url/g;
2149		s/<user_ID>/$in_user/g;
2150		s/<password>/$raw_pass/g;
2151		push(@body,$_);
2152		}
2153		my $from = $admin_mail[0];
2154		if (!$admin_mail[0]) {
2155		# ????????[????o?^??????o?^??????[???A?h???X????M????? $from = $in_mail;
2156		}
2157		my $mode2 = param('mode2');
2158		my $tm = param('tm');
2159		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>$mode2,'tm'=>$tm);
2160		$html .= qq(<div style="text-align:center;margin:1em;">\n);
2161		$html .= qq(?????e????[??????M????;
2162		$html .= qq(<form action="$script" method="post">\n);
2163		$html .= &hidden_param(%param);
2164		$html .= qq(<div style="margin:1em"><table border="1" cellpadding="4" cellspacing="0" style="margin:auto;" summary="???[?????M?t?H?[??">\n);
2165		$html .= qq(<tr><td style="text-align:right;">Subject:</td><td style="text-align:left;">${simple_title}?o?^???m???/td></tr>\n);
2166		$html .= qq(<tr><td style="text-align:right;">From:</td><td style="text-align:left;">$from</td></tr>\n);
2167		$html .= qq(<tr><td style="text-align:right;">To:</td><td style="text-align:left;">$in_mail</td></tr>\n);
2168		$html .= qq(<tr><td style="text-align:right;vertical-align:top;">?{??/td><td><textarea name="cont" rows=") . (scalar(@body) + 1) . qq(" cols="80">\n);
2169		foreach (@body) {
2170		$html .= $_;
2171		}
2172		$html .= qq(</textarea></td></tr>\n);
2173		$html .= qq(<tr><td colspan="2"><div style="font-size:90%">??{???C????????A?t?H?[??????W?????M?{?^????????????/div><input type="submit" name="send" value="????e????M" /> \n);
2174		$html .= qq(<input type="submit" value="?L?????Z??" onclick="history.back(); return false;" /></td></tr>\n);
2175		$html .= qq(</table>\n);
2176		$html .= qq(</div>\n);
2177		$html .= qq(</form>\n);
2178		$html .= qq(</div>\n);
2179		}
2180		return $html;
2181		}
2182
2183
2184		sub send_url {
2185		my $name = $id;
2186		my @template;
2187		@template = &read_file('./mail_template/u2g.txt');
2188		open(USR,'./user.cgi');
2189		my @user = <USR>;
2190		close(USR);
2191		&header;
2192		if (param('nomail')) {
2193		# ?Q?X?g?p?p?X???h?t?@?C?????? my $tmp = param('dir');
2194		$tmp =~ s/^\.\///;
2195		&make_dir(join('/',$passdir,$tmp)) if ! -d join('/',$passdir,$tmp);
2196		my $pass_file_path = join('/',$passdir,$tmp, param('time') . '.cgi');
2197
2198		if (open(PAS,">$pass_file_path")) {
2199		print PAS join('<>',&encrypt(param('guest_pass')),param('dir'),param('kigen'),"\n");
2200		close(PAS);
2201		} else {
2202		&error(qq(${pass_file_path}????????????);
2203		}
2204		my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2205		if ($post_only) {
2206		print qq(<div style="margin:1em;text-align:center;"><form action="$script" method="post" stykle="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g?????? /></form></div>\n);
2207		} else {
2208		print qq(<div style="margin:1em;text-align:center;"><a href="$script) . &url_param(%param) . qq(">?f?B???N?g??????/a></div>\n);
2209		}
2210		print qq(<div style="margin:1em;text-align:center;"><table style="margin:auto;text-align:left;"><tr><td>\n);
2211		print qq(?Q?X?g?A?J?E???g????????B\n);
2212		if (param('kigen') ne 'p') {
2213		my $kigen = &presenttime(param('time') + param('kigen') * 3600 * 24);
2214		$kigen =~ s/:\d{2}$//;
2215		print qq(<strong>${kigen}</strong>???L????B<br />\n);
2216		} else {
2217		print qq(?L??????????B<br />\n);
2218		}
2219		print qq(????RL??A?N?Z?X?????B\n);
2220		print qq(<span style="color:red">???RL???????????A?K?v??????R?s?[???????????B</span><br />\n);
2221		print qq(<span style="color:red">???[??????M????????/span>???A????RL??R?s?[??A???[???[????t?@?C??????n??????????????B<br />\n);
2222		print qq(?p?X???h??strong>) . param('guest_pass') . qq(</strong>???B);
2223		print qq(</td></tr></table></div>\n);
2224		my $url = url;
2225		my $dir = param('dir');
2226		my $tpass = param('tpass');
2227		my $time = param('time');
2228		$url .= qq(?mode=login&dir=$dir&id=) . &url_encode($id) . qq(&time=$time); # ???id?????????????? if ($post_only) {
2229		print qq(<div style="margin:1em;text-align:center;">$url</div>\n);
2230		} else {
2231		print qq(<div style="margin:1em;text-align:center;"><a href="$url" target="_blank">$url</a></div>\n);
2232		}
2233		&footer;
2234		exit;
2235		}
2236		my $mail_title = qq(${simple_title}URL???m???; # ???[???p?^?C?g??
2237		if (param('send') eq '????e????M') {
2238		&error('???[?????M?G???[','???M????[???A?h???X???L????) if ! param('sendfrom');
2239		&error('???[?????M?G???[','???M????[???A?h???X???L????) if ! param('sendto');
2240		my ($mbody,$msg,$send_to,$_msg);
2241		$mail_title = param('subject') if param('subject');
2242		if ($encode_lib == 1) {
2243		eval 'use Jcode;';
2244		Jcode::convert(\$mail_title, "jis");
2245		} else {
2246		require 'jcode.pl';
2247		&jcode::convert(\$mail_title, "jis");
2248		}
2249		# ?Q?X?g?p?p?X???h?t?@?C?????? my $tmp = param('dir');
2250		$tmp =~ s/^\.\///;
2251		&make_dir(join('/',$passdir,$tmp)) if ! -d join('/',$passdir,$tmp);
2252		my $pass_file_path = join('/',$passdir,$tmp, param('time') . '.cgi');
2253
2254		if (open(PAS,">$pass_file_path")) {
2255		print PAS join('<>',&encrypt(param('guest_pass')),param('dir'),param('kigen'),param('sendto'),"\n");
2256		close(PAS);
2257		} else {
2258		&error(qq(${pass_file_path}????????????);
2259		}
2260
2261		# ???[???^?C?g?????`
2262		require './mimew.pl';
2263		my $msub = &mimeencode("$mail_title");
2264
2265		# ?{???e??W
2266		$msg = param('cont');
2267		$msg =~ s/<br>/\n/g;
2268		$msg =~ s/\r//g;
2269		$msg =~ s/<([^>]\|\n)*>//g;
2270		$msg =~ s/</??/g;
2271		$msg =~ s/>/??/g;
2272		$msg =~ s/&/??/g;
2273		$msg =~ s/"/?h/g;
2274		my $kigen = &presenttime(param('time') + param('kigen') * 3600 * 24);
2275		$kigen =~ s/:\d{2}$//;
2276		# ???M???L??????X??????????A?L????????u?? if (param('kigen') ne 'p') {
2277		$msg =~ s/(?LURL??L?????\d{4}\/\d{1,2}\/\d{1,2}$.{2}$ \d{2}:\d{2}/$1$kigen/;
2278		} else {
2279		$msg =~ s/(?LURL??L?????\d{4}\/\d{1,2}\/\d{1,2}$.{2}$ \d{2}:\d{2}.*\n//;
2280		}
2281		my $sendto = param('sendto');
2282		my @sendto_list = split(/:/,$sendto);
2283		if ( param('sendtoname') ) {
2284		$sendto_list[0] = &mimeencode(qq(") . param('sendtoname') . qq($mr" <) . param('sendto') . qq(>));
2285		}
2286		$mbody = $msg;
2287
2288		if ($encode_lib == 1) {
2289		Jcode::convert(\$mbody, "jis");
2290		} else {
2291		&jcode::convert(\$mbody, "jis");
2292		}
2293		my $from = param('sendfrom');
2294		my $from_name = &mimeencode("$name$$simple_title$ <$from>") if $name;
2295		# sendmail???M
2296		my $count = 0;
2297		foreach $send_to (@sendto_list) {
2298		open(MAIL,"\| $sendmail -f $from -t -i") \|\| &error("???[?????M???s");
2299		print MAIL qq(From: $from_name\n) if $name;
2300		print MAIL qq(To: $send_to\n);
2301
2302		my ($cc, $bcc);
2303		if (param('hikae')) {
2304		$bcc .= $from;
2305		}
2306		if ($show_cc && ! $count) {
2307		if (param('cc')) {
2308		$cc .= param('cc');
2309		print MAIL "CC: $cc\n";
2310		}
2311		if (param('bcc')) {
2312		$bcc .= ',' . param('bcc');
2313		}
2314		}
2315		if ($bcc && ! $count) {
2316		print MAIL "BCC: $bcc\n";
2317		}
2318		print MAIL "Subject: $msub\n";
2319		print MAIL "MIME-Version: 1.0\n";
2320		print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
2321		print MAIL "Content-Transfer-Encoding: 7bit\n";
2322		print MAIL "X-Mailer: multiupload $ver\n\n";
2323		foreach ( split(/\n/, $mbody) ) {
2324		if ($encode_lib == 1) {
2325		Jcode::convert(\$_, 'jis', 'sjis');
2326		} else {
2327		&jcode::convert(\$_, 'jis', 'sjis');
2328		}
2329		print MAIL $_ . "\n";
2330		}
2331		close(MAIL);
2332		$count++;
2333		}
2334		print qq(<div style="margin:1em;text-align:center;">???[??????M?????/div>\n);
2335		my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2336		if ($post_only) {
2337		print qq(<div style="margin:1em;text-align:center;"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g?????? /></form></div>\n);
2338		} else {
2339		print qq(<div style="margin:1em;text-align:center;"><a href="$script) . &url_param(%param) . qq(">?f?B???N?g??????/a></div>\n);
2340		}
2341		# ?v???r???[????
2342		} else {
2343		my $url = my $cgi = url;
2344		my @body;
2345		my $name = $id;
2346		my $dir = param('dir');
2347		# ?????[?U?[???rypt???p?X???h????? my ($guest_pass,$crypt_pass,$time);
2348		if (! param('guest_pass')) {
2349		$guest_pass = &auto_pass(8,1,1); # ?????????A????p?X???h???? } else {
2350		$guest_pass = param('guest_pass');
2351		}
2352		$time = time if ! $time;
2353		$url .= qq(?mode=login&dir=$dir&id=) . &url_encode($id) . qq(&time=$time); # ???id?????????????? foreach (@template) {
2354		chomp;
2355		s/<name>/$name/g;
2356		s/<url>/$url/g;
2357		s/<pass>/$guest_pass/g;
2358		push(@body,$_);
2359		}
2360		my $from;
2361		$from = $mail{"$name"};
2362		$from = param('sendfrom') if param('sendfrom');
2363		print qq(<div style="text-align:center;margin:1em;">\n);
2364		my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2365		if ($post_only) {
2366		print qq(<div><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g?????? /></form></div>\n);
2367		} else {
2368		print qq(<div><a href="$script) . &url_param(%param) . qq(">?f?B???N?g??????/a></div>\n);
2369		}
2370		print qq(<span style="position:relative;top:4px;right:1px"><img src="./img/mail.gif" alt="???[?????M" /></span>?t?@?C?????n????????A?????e????[??????M????B);
2371		print qq(<form action="$script" method="post" style="margin:0;">\n);
2372		my $param2 = param('param2');
2373		$time = param('time') if param('time');
2374		undef %param;
2375		%param = ('mode'=>'send_url','mode2'=>$param2,'dir'=>$dir,'time'=>$time,'guest_pass'=>$guest_pass,'login_user'=>$login_user);
2376		print &hidden_param(%param);
2377		print qq(<div><table border="1" cellpadding="4" cellspacing="0" style="margin:auto;" summary="???[?????M?t?H?[??">\n);
2378		$mail_title = param('subject') if param('subject');
2379		my $size = length($mail_title) + 4;
2380		my $tab_index_count = 1;
2381		print qq(<tr><td style="text-align:right;">Subject:</td><td style="text-align:left;"><input type="text" name="subject" value="$mail_title" size="$size" tabindex="$tab_index_count" /></td></tr>\n); $tab_index_count++;
2382		my $from_com;
2383		if (! $from) {
2384		$from_com = qq( <span style="font-size:90%">????M?????[???A?h???X??????????/span><span style="color:red;font-size:80%">(?K?{)</span>);
2385		}
2386		print qq(<tr><td style="text-align:right;">From:</td><td style="text-align:left;"><input type="text" name="sendfrom" value="$from" size="30" style="ime-mode:disabled;" tabindex="$tab_index_count" />$from_com</td></tr>\n); $tab_index_count++;
2387		my $checked;
2388		if (param('hikae')) {
2389		$checked = qq( checked="checked");
2390		} else {
2391		$checked = '';
2392		}
2393		if ($from) {
2394		print qq(<tr><td style="text-align:right;"><input type="checkbox"$checked name="hikae" value="1" tabindex="$tab_index_count" /></td><td style="text-align:left;">$from??T????[??????M???/td></tr>\n); $tab_index_count++;
2395		}
2396		my $sendto = param('sendto');
2397		my $sendtoname = param('sendtoname');
2398		my $sendto_size = '';
2399		if (length($sendto) > 30) {
2400		$sendto_size = qq( size=") . (length($sendto) * 1.2) . qq(");
2401		} else {
2402		$sendto_size = qq( size="30");
2403		}
2404		print qq(<tr><td style="text-align:right;">To:</td><td style="text-align:left;"><input type="text" name="sendto" value="$sendto"$sendto_size style="ime-mode:disabled;" tabindex="$tab_index_count" /> <span style="font-size:90%">????M?????[???A?h???X??????????/span><span style="color:red;font-size:80%">(?K?{)</span><br />);
2405		print qq(<span style="font-size:90%">??????????M???????(?R????)??????????/span></td></tr>\n); $tab_index_count++;
2406		print qq(<tr><td style="text-align:right;">??O:</td><td style="text-align:left;"><input type="text" name="sendtoname" value="$sendtoname" size="30" tabindex="$tab_index_count" /> <span style="font-size:90%">????M????O????????</span></td></tr>\n); $tab_index_count++;
2407		if ($show_cc) {
2408		print qq(<tr><td style="text-align:right;">Cc:</td><td style="text-align:left;"><input type="text" name="cc" value=") . param('cc') . qq(" size="30" style="ime-mode:disabled;" tabindex="$tab_index_count" /> </td></tr>\n); $tab_index_count++;
2409		print qq(<tr><td style="text-align:right;">Bcc:</td><td style="text-align:left;"><input type="text" name="bcc" value=") . param('bcc') . qq(" size="30" style="ime-mode:disabled;" tabindex="$tab_index_count" /> </td></tr>\n); $tab_index_count++;
2410		}
2411		my (@file_list,%pm, %size, %mod, %ind, %dir, %decode_name);
2412		my @url;
2413		if (param('send') eq '?v???r???[') {
2414		my @add_str = ();
2415		my $path = url;
2416		$path =~ s/\/?$script$//;
2417		my $tmp = $dir;
2418		$tmp =~ s/^\.\///;
2419		$path = join('/',$path,$tmp);
2420		for (my $i = 1; $i <= 10; $i++) {
2421		if (param('file' . $i)) {
2422		my $link = my $name = param('file' . $i);
2423		$link =~ s/%/%25/g;
2424		my $url;
2425		$url = &url_decode($name) . "\n" . $cgi . qq(?mode=download&dir=$dir&file=$link&id=$url_id&time=) . param('time') . qq(\n);
2426		push(@add_str, $url);
2427		}
2428		}
2429		@url = @add_str;
2430		if (@add_str) {
2431		unshift(@add_str,"");
2432		unshift(@add_str,qq(?p?X???h?? . $guest_pass . qq(???B));
2433		unshift(@add_str,qq(?t?@?C??????_?E?????[?h???????A????N???b?N???????B));
2434		unshift(@add_str,"");
2435		chomp @add_str;
2436		}
2437		if (param('cont')) {
2438		my $cnt = param('cont');
2439		$cnt =~ s/\r//g;
2440		@body = split(/\n/,$cnt);
2441		}
2442		push(@body,@add_str);
2443		} else {
2444		opendir(UPD,$dir);
2445		while (my $file = readdir(UPD)) {
2446		next if $file eq '.' \|\| $file eq '..' \|\| $file eq 'index.html' \|\| $file eq '.htaccess';
2447		next if $file =~ /_count$/;
2448		my $dm;
2449		($dm,$dm,$pm{"$file"},$dm,$dm,$dm,$dm,$size{"$file"},$dm,$mod{"$file"},$ind{"$file"},$dm) = stat(join('/',$updir,$file));
2450		$decode_name{"$file"} = &url_decode($file);
2451		if (-d join('/',$dir, $file)) {
2452		$dir{"$file"} = 1;
2453		} elsif (-f join('/',$dir, $file)) {
2454		push(@file_list,$file)
2455		}
2456		}
2457		closedir(UPD);
2458		}
2459		print qq(<tr><td style="text-align:right;vertical-align:top;">?{??/td><td><textarea name="cont" rows=") . (scalar(@body) + scalar(@url) * 3 + 4) . qq(" cols="100" tabindex="$tab_index_count">\n); $tab_index_count++;
2460		if (! (param('send') ne '?v???r???[' && @file_list) ) {
2461		my $kday = param('kigen');
2462		$kday = $max_day{"$id"} if ! $kday;
2463		$kday = $auto_delete if ! $kday;
2464		my $tm = param('time');
2465		$tm = time if ! $tm;
2466		if ($kday ne 'p') {
2467		my $kigen = &presenttime($tm + $kday * 3600 * 24);
2468		$kigen =~ s/:\d{2}$//;
2469		my $note = qq(\n?LURL??L?????{kigen}????????????A?????????B);
2470		push(@body,$note);
2471		}
2472		}
2473		if (param('chk_all')) {
2474		@body = param('cont');
2475		chomp @body;
2476		}
2477		foreach (@body) {
2478		print $_ . "\n";
2479		}
2480		print qq(</textarea></td></tr>\n);
2481		my $preview;
2482		if (! $hide_file_download_url && param('send') ne '?v???r???[') {
2483		if (@file_list) {
2484		print qq(<tr><td colspan="2" style="text-align:left;">??t?@?C?????_?E?????[?h??RL????????????`?F?b?N???????B<input type="submit" name="chk_all" value="????`?F?b?N"> <input type="submit" name="chk_all" value="??????"></td></tr>\n);
2485		$preview = 1;
2486		}
2487		my $count = 0;
2488		my $chk;
2489		if (param('chk_all') eq '????`?F?b?N') {
2490		$chk = ' checked';
2491		} elsif (param('chk_all') eq '??????') {
2492		$chk = '';
2493		}
2494		foreach (@file_list) {
2495		$count++;
2496		print qq(<tr><td style="text-align:right;"><input type="checkbox" name="file$count" id="file$count" value="$_" tabindex="$tab_index_count"$chk /></td><td style="text-align:left;"><label for="file$count">) . &url_decode($_) . qq(</label></td></tr>\n); $tab_index_count++;
2497		}
2498		}
2499		if ($preview) {
2500		print qq(<tr><td colspan="2"><div style="font-size:90%">??{???C????????A?t?H?[??????W???u?v???r???[?v?{?^????????????/div>\n);
2501		print qq(<input type="submit" name="send" value="?v???r???[" tabindex="$tab_index_count" /> \n); $tab_index_count++;
2502		} else {
2503		print qq(<tr><td colspan="2"><div style="font-size:90%">??{???C????????A?t?H?[??????W???u???M?v?{?^????????????/div>\n);
2504		print qq(<input type="submit" name="send" value="????e????M" tabindex="$tab_index_count" /> \n); $tab_index_count++;
2505		}
2506		print qq(<input type="submit" value="?L?????Z??" onclick="history.back(); return false;" tabindex="$tab_index_count" /></td></tr>\n); $tab_index_count++;
2507		print qq(<tr><td colspan="2">?A?N?Z?X?L????n);
2508		print qq(<select name="kigen">);
2509		my $kigen = param('kigen');
2510		chomp $kigen;
2511		chomp $max_day{"$id"};
2512		for (my $count=$auto_delete;$count>=1;$count--) {
2513		$kigen = 0 if ! $kigen;
2514		$max_day{"$id"} = 0 if ! $max_day{"$id"};
2515		if ((! $kigen && $count eq $max_day{"$id"}) \|\| $count eq $kigen) {
2516		print qq(<option value="$count" selected="selected">${count}??/option>);
2517		} else {
2518		print qq(<option value="$count">${count}??/option>);
2519		}
2520		}
2521		if ($kigen eq 'p') {
2522		print qq(<option value="p" selected="selected">????/option>);
2523		} else {
2524		print qq(<option value="p">????/option>);
2525		}
2526		print qq(</select></td></tr>\n);
2527		print qq(<tr><td colspan="2"><table><tr><td style="text-align:left;font-size:80%;line-height:1.5em">???t?H?[??????[??????M?????A?Q?X?g??A?J?E???g???????A?{?????RL??L????????B<br />\n);
2528		print qq(?????[???\\?t?g????????????A????u?A?J?E???g?????v?{?^????????????B</td></tr></table>\n);
2529		print qq(<input type="submit" name="nomail" value="?A?J?E???g????? style="font-size:80%" /></td></tr>\n);
2530		print qq(</table>\n);
2531		print qq(</div>\n);
2532		print qq(</form>\n);
2533		print qq(<div style="margin:0">\n);
2534		print qq(</div>\n);
2535		print qq(</div>\n);
2536		}
2537		&footer;
2538		exit;
2539		}
2540
2541		# ?o?^???[?????M
2542		sub regist_mail {
2543		my ($mail_title, $msg);
2544		$mail_title = '?y' . $simple_title . '?z' . "$id${mr}?o?^";
2545		my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
2546		$year+=1900;
2547		$mon++;
2548		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
2549		$msg = <<"EOM";
2550		---------------------------------------------------------------
2551		<title><url>
2552		???o?^?????m?????---------------------------------------------------------------
2553		<date>
2554
2555		?????e??o?^????????B
2556
2557		???[?U?[ID?F<user>
2558		?p?X???h?F<pass>
2559		??p?f?B???N?g??=<dir>
2560		EOM
2561		my $tmp_pass = param('pass');
2562		my $url = url;
2563		my $dir = $url . qq(?dir=$updir&id=) . &url_encode($id);
2564		$msg =~ s/<date>/$tm_com/g;
2565		$msg =~ s/<title>/$simple_title/g;
2566		$msg =~ s/<user>/$id/g;
2567		$msg =~ s/<mr>/$mr/g;
2568		$msg =~ s/<pass>/$tmp_pass/g;
2569		$msg =~ s/<url>/$url/g;
2570		$msg =~ s/<dir>/$dir/g;
2571		&mail($mail_title, $msg, $mail{"$id"}, $admin_mail[0]);
2572		}
2573
2574		sub upload_notify {
2575		chomp $files;
2576		$mail_title = '?y' . $simple_title . '?z' . "?t?@?C???A?b?v???[?h";
2577		my $url = url;
2578		$url .= qq(?dir=) . param('dir');
2579		my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
2580		$year+=1900;
2581		$mon++;
2582		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
2583		$msg = <<"EOM";
2584		---------------------------------------------------------------
2585		<title>???t?@?C???A?b?v???[?h???m?????---------------------------------------------------------------
2586		<date>
2587
2588		<user>${mr}??<url>
2589		??---------------------------------------------------------------
2590		<files>
2591		---------------------------------------------------------------
2592		??A?b?v???[?h?????B
2593		EOM
2594		my $user = $id;
2595		$user .= '(?Q?X?g)' if $login_guest;
2596		$msg =~ s/<date>/$tm_com/g;
2597		$msg =~ s/<user>/$user/g;
2598		$msg =~ s/<mr>/$mr/g;
2599		$msg =~ s/<url>/$url/g;
2600		$msg =~ s/<files>/$files/g;
2601		$msg =~ s/<title>/$simple_title/g;
2602		foreach (@admin_mail) {
2603		&mail($mail_title, $msg, $_, $admin_mail[0]);
2604		}
2605		}
2606
2607		# ???[?????M
2608		sub notify {
2609		my ($mail_title, $msg, $send_to) = @_;
2610		&mail($mail_title, $msg, $send_to, $admin_mail[0]);
2611		}
2612
2613		sub mail {
2614		my ($mail_title, $msg, $send_to, $send_from) = @_;
2615		$send_from = $admin_mail[0] if ! $send_from;
2616		if ($encode_lib == 1) {
2617		eval 'use Jcode;';
2618		Jcode::convert(\$mail_title, "jis");
2619		} else {
2620		require 'jcode.pl';
2621		&jcode::convert(\$mail_title, "jis");
2622		}
2623
2624		# ???[???^?C?g?????`
2625		require './mimew.pl';
2626		my $msub = &mimeencode("$mail_title");
2627
2628		# ?{???e??W
2629		$msg =~ s/<br>/\n/g;
2630		$msg =~ s/<([^>]\|\n)*>//g;
2631		$msg =~ s/</??/g;
2632		$msg =~ s/>/??/g;
2633
2634		# MIME?G???R?[?h
2635		require './mimew.pl';
2636		my $mbody = $msg;
2637		if ($encode_lib == 1) {
2638		Jcode::convert(\$mbody, "jis");
2639		} else {
2640		&jcode::convert(\$mbody, "jis");
2641		}
2642		my $from_name;
2643		if (param('mode2') eq 'send_mail') {
2644		$from_name = &mimeencode("${simple_title}$admin_name <$send_from>");
2645		} else {
2646		$from_name = &mimeencode("${simple_title}??????M <$send_from>");
2647		}
2648		# sendmail???M
2649		open(MAIL,"\| $sendmail -f $send_from -t -i") \|\| &error("???[?????M???s");
2650		print MAIL qq(From: $from_name\n); # -f?I?v?V??????????????????? print MAIL qq(To: $send_to\n);
2651		print MAIL "Subject: $msub\n";
2652		print MAIL "MIME-Version: 1.0\n";
2653		print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
2654		print MAIL "Content-Transfer-Encoding: 7bit\n";
2655		print MAIL "X-Mailer: multiupload $ver\n\n";
2656		foreach ( split(/\n/, $mbody) ) {
2657		if ($encode_lib == 1) {
2658		Jcode::convert(\$_, 'jis', 'sjis');
2659		} else {
2660		&jcode::convert(\$_, 'jis', 'sjis');
2661		}
2662		print MAIL $_, "\n";
2663		}
2664		close(MAIL);
2665		}
2666
2667		sub admin {
2668		$title .= qq( ?\|????????\|);
2669		my $html;
2670		my $mode2 = param('mode2');
2671		$mode2 = 'user' if ! $mode2;
2672		if ($mode2 eq 'send_mail') {
2673		$html = &send_mail;
2674		} elsif ($mode2 eq 'user') {
2675		$title .= qq( ???[?U?[???);
2676		$html = &manage_user;
2677		} elsif ($mode2 eq 'config') {
2678		$title .= qq( ?X?N???v?g????;
2679		$html = &config('????????X',1);
2680		} elsif ($mode2 eq 'dir_arrange') {
2681		$title .= qq( ?f?B???N?g?????);
2682		$html = &dir_arrange;
2683		} elsif ($mode2 eq 'file_manage') {
2684		$title .= qq( ?t?@?C?????);
2685		$html = &file_manage;
2686		} elsif ($mode2 eq 'show_acc_log') {
2687		$title .= qq( ?A?N?Z?X???O);
2688		$html = &show_acc_log;
2689		} elsif ($mode2 eq 'admin_pass_chg') {
2690		$title .= qq( ??????p?X???h??X);
2691		$html = &admin_pass_chg;
2692		}
2693		&header;
2694		print qq(<div style="background-color:#eeeeee;padding:0.3em 1em 0.5em 0.5em">);
2695		my %param = ('login_admin'=>$login_admin);
2696		if ($post_only) {
2697		print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$root?f?B???N?g?????? /></form>);
2698		} else {
2699		print qq(<a href="$script) . &url_param(%param) . qq(">$root?f?B???N?g??????/a>);
2700		}
2701		print qq(</div>\n);
2702		print qq(<div style="padding:0.5em 1em 0 1em">\n);
2703		my ($st1,$st2,$st3,$st4,$st5,$st6);
2704		my $color = '#0000aa';
2705		$st1 = qq( style="color:blue") if $mode2 eq 'user';
2706		$st2 = qq( style="color:blue") if $mode2 eq 'config';
2707		$st3 = qq( style="color:blue") if $mode2 eq 'dir_arrange';
2708		$st4 = qq( style="color:blue") if $mode2 eq 'file_manage';
2709		$st5 = qq( style="color:blue") if $mode2 eq 'show_acc_log';
2710		$st6 = qq( style="color:blue") if $mode2 eq 'admin_pass_chg';
2711		my ($acc_log_link);
2712		if (-e $access) {
2713		my %param = ('mode'=>'admin','mode2'=>'show_acc_log','login_admin'=>$login_admin);
2714		if ($post_only) {
2715		$acc_log_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?A?N?Z?X???O"$st5 /></form>\n);
2716		} else {
2717		$acc_log_link = qq([<a href="$script) . &url_param(%param) . qq("$st5>?A?N?Z?X???O</a>] \n);
2718		}
2719		}
2720		print qq(<table summary="????????C???f?b?N?X"><tr>);
2721		$param{'mode'} = 'admin';
2722		$param{'mode2'} = 'user';
2723		if ($post_only) {
2724		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???[?U?[???"$st1 /></form></td>\n);
2725		} else {
2726		print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st1>???[?U?[???</a>]</td>\n);
2727		}
2728		$param{'mode2'} = 'config';
2729		if ($post_only) {
2730		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?X?N???v?g????$st2 /></form></td>\n);
2731		} else {
2732		print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st2>?X?N???v?g????/a>]</td>\n\n);
2733		}
2734		$param{'mode2'} = 'dir_arrange';
2735		if ($post_only) {
2736		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g?????"$st3 /></form></td>\n);
2737		} else {
2738		print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st3>?f?B???N?g?????</a>]</td>\n\n);
2739		}
2740		$param{'mode2'} = 'file_manage';
2741		if ($post_only) {
2742		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?t?@?C?????"$st4 /></form></td>\n);
2743		} else {
2744		print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st4>?t?@?C?????</a>]</td>\n\n);
2745		}
2746		print qq(<td>) . $acc_log_link . qq(</td>\n);
2747		$param{'mode2'} = 'admin_pass_chg';
2748		if ($post_only) {
2749		print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="??????p?X???h??X"$st6 /></form></td>\n);
2750		} else {
2751		print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st6>??????p?X???h??X</a>]</td>\n\n);
2752		}
2753		print qq(<td><a href="adminhelp.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="?w???v" />?w???v</a></td>\n);
2754		print qq(</tr></table>\n</div>\n);
2755		if (param('comment')) {
2756		print qq(<div style="margin:1em;color:red">) . param('comment') . qq(</div>\n);
2757		}
2758		print qq(<div style="padding:0.5em 1em 1em 1em">\n);
2759		print $html;
2760		print qq(</div>\n);
2761		&footer;
2762		exit;
2763		}
2764
2765		sub admin_pass {
2766		# ??????p?X???h???????Aconfig.cgi??ultiupload.cgi_bck.cgi???????A????????p?? my ($load_config);
2767		# config.cgi????????
2768		if ($config_file && -e $config_file && open(CFG,$config_file)) {
2769		@config_value = <CFG>;
2770		close(CFG);
2771		foreach (@config_value) {
2772		my($cname,$val) = split(/<>/);
2773		chomp $val;
2774		# ?????t?@?C?????????p?X???h??????????A????????? if ($cname eq 'adminpass' && $val) {
2775		$load_config = 1;
2776		last;
2777		}
2778		}
2779
2780		# config.cgi????????A?o?b?N?A?b?v?t?@?C??????????
2781		} elsif (-e "${script}_bck.cgi" && open(BCK,"${script}_bck.cgi")) {
2782		my @scr = <BCK>;
2783		close(BCK);
2784		foreach my $cfg ('adminpass','passdir',@config) {
2785		my (@tmp, $com, $name, $value,$config_start,$config_end);
2786		foreach my $line (@scr) {
2787		if ($line =~ /^# config_start/) { $config_start = 1; }
2788		next if ! $config_start;
2789		if ($line =~ /^# config_end/) { $config_end = 1; }
2790		if ($config_end) { last; }
2791		if ($line =~ /^\s*#/) { next; }
2792		if ($line =~ /\s(my)?\s\$$cfg\s=\s/) {
2793		@tmp = split(/;/,$line);
2794		$com = pop(@tmp);
2795		chomp $com;
2796		list($name, $value) = explode('=',$tmp[0]);
2797		$name =~ s/^\smy\s[^\$]//;
2798		$name =~ s/\s*$//;
2799		$value =~ s/^\s*['"]?//;
2800		$value =~ s/['"]?\s*$//;
2801		last;
2802		}
2803		}
2804		push(@config_value,qq($cfg<>$value));
2805		if ($cfg eq 'adminpass' && $value) {
2806		$load_config = 1;
2807		}
2808		}
2809		}
2810		if ($load_config) {
2811		$title .= ' ?\|????????\|';
2812		&load_config;
2813		} else {
2814		$title .= ' ?\|????\|';
2815		&create_pass;
2816		}
2817		exit;
2818		}
2819
2820		sub admin_pass_chg {
2821		my ($html, %comment);
2822		if (param('new_pass_do')) {
2823		my @init = &read_file($script);
2824		my @new_init = ();
2825		my $new_pass = param('new_pass');
2826		if ($new_pass) {
2827		my ($crypt_pass, $config_end);
2828		foreach my $line (@init) {
2829		my $tmp = $line;
2830		if ($line =~ /^# config_end/) { $config_end = 1; }
2831		$tmp =~ s/ //g;
2832		if (! $config_end && $tmp =~ /^(my)?\s\$adminpass\s='/) {
2833		# ???????????p?p?X???h??rypt???pass????????????? if (length($new_pass) < $pass_length) {
2834		&error('?p?X???h?G???[',"?p?X???h??{pass_length}?????????????);
2835		}
2836		$crypt_pass = &encrypt($new_pass);
2837		my @tmp = split(/;/,$line);
2838		my $com = pop(@tmp);
2839		my $new_pass = 'my $adminpass = ' . qq(') . $crypt_pass . qq(';) . $com;
2840		push(@new_init,$new_pass);
2841		} else {
2842		push(@new_init,$line);
2843		}
2844		}
2845		# $script?????O??o?b?N?A?b?v???@rename???script??????????????_??
2846		open(INIT,">${script}_bck.cgi") \|\| &error("${script}_bck.cgi??J?????B");
2847		print INIT @init;
2848		close(INIT);
2849
2850		# $script????? open(INIT,">$script") \|\| &error("${script}??J?????B");
2851		print INIT @new_init;
2852		close(INIT);
2853		$comment{'chg_pass'} .= qq(<span style="color:blue">?p?X???h???X?????B</span>);
2854		$pass = $new_pass;
2855
2856		if ($use_htaccess) {
2857		# .htpasswd????????p?X???h??C?? @dir_list = ();
2858		&get_subdir($passdir);
2859		foreach my $path (@dir_list) {
2860		opendir(SUB,$path);
2861		while(my $file = readdir(SUB)) {
2862		if ($file eq '.htpasswd') {
2863		my $pass_path = join('/',$path,$file);
2864		my @htpass = &read_file($pass_path);
2865		foreach (@htpass) {
2866		my($name,$pass) = split(/:/);
2867		if ($name eq $admin_id) {
2868		$_ = qq($name:$crypt_pass\n);
2869		}
2870		}
2871		open(PAS,">$pass_path");
2872		print PAS @htpass;
2873		close(PAS);
2874		}
2875		}
2876		closedir(SUB);
2877		}
2878		}
2879		} else {
2880		$comment{'chg_pass'} .= qq(<span style="color:red">?p?X???h???????????B</span>);
2881		}
2882		}
2883		$html .= $comment{'chg_pass'};
2884		$html .= qq(<form action="$script" method="post" style="padding:0">\n);
2885		$html .= qq(<input type="hidden" name="mode" value="admin" />\n);
2886		$html .= qq(<input type="hidden" name="mode2" value="admin_pass_chg" />\n);
2887		$html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
2888		$html .= qq(<table cellpadding="0" summary="?p?X???h?t?H?[??">\n);
2889		$html .= qq(<tr><td colspan="2">?????????[?U?[??nbsp;?F <span style="font-size:120%">$admin_id</span></td></tr>\n);
2890		$html .= qq(<tr><td>?V???p?X???h</td><td><a name="anchor" id="anchor"><input type="password" name="new_pass" value="" style="margin:0.3em" tabindex="1" /></a> );
2891		$html .= qq(<a name="pass_chg" id="pass_chg"><input type="submit" name="new_pass_do" value="??X??? style="margin:0.3em" tabindex="2" /></a></td></tr>\n);
2892		$html .= qq(</table>\n);
2893		$html .= qq(</form>\n);
2894		return $html;
2895		}
2896
2897
2898
2899		sub manage_user {
2900		my $in_user = param('in_user');
2901		my ($comment,$send_mail_link);
2902		if (param('show_pass') && param('tm')) {
2903		my ($html, $user, $rpass);
2904		my $tm = param('tm');
2905		foreach (@user) {
2906		my ($t,$usr) = split(/\,/);
2907		if ($t == $tm) {
2908		$user = $usr;
2909		last;
2910		}
2911		}
2912		open(RAW,join('/',$passdir,'raw_pass.cgi'));
2913		my @raw_pass = <RAW>;
2914		close(RAW);
2915		foreach (@raw_pass) {
2916		my ($t,$rp) = split(/\,/);
2917		if ($tm == $t) {
2918		$rpass = $rp;
2919		$rpass = &rechange($rpass);
2920		}
2921		}
2922		$html .= qq(<strong>$user</strong>${mr}??p?X???h : $rpass);
2923		return $html;
2924		} elsif($in_user && (param('new_user') \|\| param('modify') \|\| param('del'))) {
2925		if ($in_user eq $admin_id) { &error('?G???[',"???[?U?[???{admin_id}??g?p??????B"); }
2926		if (length($in_user) > $max_user_id) { &error('???[?U?[??G???[',"???[?U?[????p??{max_user_id}????A?S?p?? . (int($max_user_id / 2)) . '?????????????B'); }
2927		if ($use_htaccess && $in_user =~ /:/) { &error('???[?U?[??G???[','???[?U?[???(?R????)??g?????????B'); }
2928		&lock();
2929		my (@user, @raw_pass);
2930		@user = &read_file("./user.cgi");
2931		@raw_pass = &read_file(join('/',$passdir,'raw_pass.cgi'));
2932		my $in_path = my $tmp_path = param('in_path');
2933		$tmp_path =~ s/^\.\///; # ???/??????????
2934		$in_path =~ s/\/$//; # ???????????????
2935		my $index = join('/',$passdir,'index.html');
2936		if (! -f $index) {
2937		open(INDX,">$index");
2938		close(INDX);
2939		}
2940		my $pass_file_path = join('/',$passdir,$tmp_path,'.htpasswd'); # ?p?X???h?t?@?C????p?X
2941		my @new_user = ();
2942		my $new_data = 1; # ?o?^??????????A0???? my $in_tm = param('in_tm');
2943		my $in_permit = param('upload') + param('delete') * 2 + param('permission') * 4 + param('cgi') * 8;
2944		my $in_pass = param('in_pass');
2945		my $dir_flag = 0; # ?f?B???N?g???????????A1???? my $raw_pass = $in_pass; # ??????p?X???h
2946		$in_pass = &encrypt($in_pass) if $in_pass;
2947		my $in_size = param('in_size') * 1024 * 1024;
2948		my $in_mail = param('in_mail');
2949
2950		# ?V?K?o?^?????A????g?p???????O?????`?F?b?N
2951		if (! $in_tm) {
2952		foreach (@user) {
2953		my ($tm, $user, $path, $pass, $permit, $l_size) = split(/\,/);
2954		$user = &rechange($user);
2955		if ($user eq $in_user) { &error('?G???[', "${in_user}?????g?p???????B????O????????B"); }
2956		}
2957		}
2958		if (param('in_pass') && length(param('in_pass')) < $pass_length) { &error('?G???[',"?p?X???h??{pass_length}?????????????); }
2959		if (!$in_permit) { &error('?G???[',"??????????w????????B"); }
2960		if ($user_mail_neces && !$in_mail && ! param('del')) { &error('?G???[',"???[???A?h???X???L????B"); }
2961		if ($chk_mail) {
2962		require './email_chk.pl';
2963		if ($in_mail && ! &email_chk($in_mail) && ! param('del')) { &error('?G???[',"???[???A?h???X????????????????B"); }
2964		}
2965		if (!$in_path) { &error('?G???[',"?f?B???N?g????w????????B");
2966		} elsif ($in_path ne $root && index($in_path, $root . '/') != 0) { # ?f?B???N?g?????????????
2967		if (index($in_path, $root) == 0) {
2968		&error("?f?B???N?g?????G???[","${in_path}?????????B?f?B???N?g?????????????????);
2969		} else {
2970		&error("?f?B???N?g?????G???[","${in_path}?????????B?f?B???N?g????{root}????f?B???N?g??????????B");
2971		}
2972		} elsif (!-d $in_path) {
2973		&make_dir($in_path);
2974		$dir_flag = 1;
2975		}
2976
2977		# $in_path???htaccess???B?p?X???h?t?@?C????p?X??join('/',$passdir,$in_path,'.htpasswd')
2978		# ????p?X???h?t?@?C?????B?p?X??join('/',$passdir,$in_path,'.htpasswd')
2979		# ???htpasswd?????D??p?X???h??A????o?^?????[?U?[??????A$in_path????f?B???N?g??????[?g????[?U?[?S?? # @user???path????o??A$in_path????f?B???N?g?????????[?U?[??s?b?N?A?b?v?B???$in_path =~ /^$path/
2980		my (@parent_user_list,@child_user_list,%path,%pass);
2981		if ($use_htaccess) {
2982		my $pass_file_dir = $pass_file_path;
2983		$pass_file_dir =~ s/\/\.htpasswd//;
2984		&make_dir($pass_file_dir) if ! -d $pass_file_dir; # ?p?X???h?t?@?C????u??f?B???N?g????????????? my $file_path = qq($fullpath/$pass_file_path);
2985		my $hta_str = <<"EOF";
2986		AuthType Basic
2987		AuthName "?}???`?A?b?v???[?h?F?
2988		AuthUserFile $file_path
2989		require valid-user
2990		<Files ~ "^.(htpasswd\|htaccess)$">
2991		deny from all
2992		</Files>
2993		EOF
2994		my $htac = join('/', $in_path, $htaccess);
2995		open(HTA,">$htac");
2996		print HTA $hta_str;
2997		close(HTA);
2998		}
2999		my (@del_list, %del_htac, %use_htac, $del_user_name);
3000		foreach my $line (@user) {
3001		my list($tm, $user, $path, $pass, $permit, $l_size,$mail,$mxday,$mxdown) = explode('\,',$line);
3002		chomp $mxday;
3003		$user = &rechange($user);
3004		my $del = param('del');
3005		my $del_flag = 0;
3006		if ($tm eq $in_tm) {
3007		$new_data = 0;
3008		if ($del eq '?o?^????') {
3009		$del_flag = 1;
3010		push(@del_list,$user);
3011		$del_htac{"$user"} = $path; # .htaccess???????f?B???N?g?????? $comment .= qq(<div style="color:red"><strong>$user</strong>?????????B</div>);
3012		} elsif (param('modify')) {
3013		$in_pass = $pass if !$in_pass;
3014		$user = $in_user;
3015		$path = $in_path;
3016		$pass = $in_pass;
3017		my $e_in_user = &change($in_user);
3018		$mxday = $auto_delete if ! $mxday;
3019		$mxdown = $max_dl_count if ! $mxdown;
3020		if ($in_path !~ /^$user_root/) {
3021		$mxday = '';
3022		$mxdown = '';
3023		}
3024		$line = qq($tm,$e_in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$mxday,$mxdown,\n);
3025		if ($in_path ne $path) {
3026		$del_htac{"$user"} = $path; # ?f?B???N?g?????X????????A???f?B???N?g????htaccess???????f?B???N?g??????? }
3027		if ($in_user ne $user) {
3028		$del_user_name = $user;
3029		}
3030		$comment .= qq(<span style="color:blue"><strong>$user</strong>??????X?????B</span><br />);
3031		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$tm);
3032		if ($post_only) {
3033		$send_mail_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="${user}${mr}????[??????? /></form>) if $in_mail;
3034		} else {
3035		$send_mail_link = qq(<a href="$script) . &url_param(%param) . qq("><strong>${user}${mr}</strong>????[???????/a>) if $in_mail;
3036		}
3037		$comment .= qq(<div style="color:blue">${in_path}????????B</div>) if $dir_flag;
3038		foreach ('./upload/usr_root','./upload','./upload/root') {
3039		if ($path eq $_) {
3040		$comment .= qq(<div style="color:red">?f?B???N?g????{path}?????A${user}??{path}???????[?U?[?f?B???N?g???????A?N?Z?X???????????B<br />\n);
3041		$comment .= qq(?????R??????A${root}/root/guest?????A${root}/root??T?u?f?B???N?g???????????????B</div>);
3042		}
3043		}
3044		if ($in_path ne join('/',$root,'root') && index($in_path, join('/',$root,'root')) >= 0 && index($in_path, join('/',$root,'root/')) < 0) {
3045		$comment .= qq(<div style="color:red">${in_path}?? . join('/',$root,'root') . qq(??T?u?f?B???N?g???????????B<br />);
3046		$comment .= join('/',$root,'root') . qq(?????????f?B???N?g????A) . join('/',$root,'root') . qq(??T?u?f?B???N?g?????X????????????B</div>);
3047		}
3048		}
3049		}
3050		if (!$del_flag) {
3051		push(@new_user,$line);
3052		$use_htac{"$path"} = 1;
3053		if ($use_htaccess) {
3054		$path{"$user"} = $path;
3055		$pass{"$user"} = $pass;
3056		if ($in_path =~ /^$path/) { push(@parent_user_list,$user); }
3057		if ($path =~ /^$in_path/) { push(@child_user_list,$user); }
3058		}
3059		}
3060		}
3061		my $time = time;
3062		if ($new_data && param('new_user')) {
3063		if (!$in_pass) { &error("?G???[","?p?X???h????R????B"); }
3064		my $e_in_user = &change($in_user);
3065		my $line = qq($time,$e_in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,,,\n);
3066		push(@new_user,$line);
3067		$comment .= qq(<div style="color:red"><strong>$in_user</strong>????????B</div>);
3068		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$time);
3069		if ($post_only) {
3070		$send_mail_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="${in_user}${mr}????[??????? /></form>) if $in_mail;
3071		} else {
3072		$send_mail_link = qq(<a href="$script?) . &url_param(%param) . qq("><strong>${in_user}${mr}</strong>????[???????/a>) if $in_mail;
3073		}
3074		foreach ('./upload/usr_root','./upload','./upload/root') {
3075		if ($in_path eq $_) {
3076		$comment .= qq(<div style="color:red">?f?B???N?g????{in_path}?????A${in_user}??{in_path}???????[?U?[?f?B???N?g???????A?N?Z?X???????????B<br />\n);
3077		$comment .= qq(?????R??????A${root}/root/guest?????A${root}/root??T?u?f?B???N?g???????????????B</div>);
3078		}
3079		}
3080		if ($in_path ne join('/',$root,'root') && index($in_path, join('/',$root,'root')) >= 0 && index($in_path, join('/',$root,'root/')) < 0) {
3081		$comment .= qq(<div style="color:red">${in_path}?? . join('/',$root,'root') . qq(??T?u?f?B???N?g???????????B<br />);
3082		$comment .= join('/',$root,'root') . qq(?????????f?B???N?g????A) . join('/',$root,'root') . qq(??T?u?f?B???N?g?????X????????????B</div>);
3083		}
3084		}
3085		open(USR,">./user.cgi");
3086		print USR @new_user;
3087		close(USR);
3088
3089		my %regtm;
3090		foreach (@new_user) {
3091		my $tm = (split(/\,/))[0];
3092		$regtm{"$tm"} = 1; # ?o?^?G?\|?b?N????L?[????n?b?V?????? }
3093		if ($new_data) {
3094		my $e_raw_pass = &change($raw_pass);
3095		my $line = qq($time,$e_raw_pass,\n);
3096		push(@raw_pass,$line);
3097		} elsif ($raw_pass) {
3098		my @new_raw_pass = ();
3099		my $add;
3100		foreach my $line (@raw_pass) {
3101		my $tm = (split(/,/,$line))[0];
3102		if ($in_tm == $tm) {
3103		my $e_raw_pass = &change($raw_pass);
3104		$line = qq($in_tm,$e_raw_pass,\n);
3105		}
3106		if ($regtm{"$tm"}) {
3107		push(@new_raw_pass,$line); # user.cgi??o?^?????????
3108		$add = 1 if $tm == $in_tm;
3109		}
3110		}
3111		# ?X?V????p?X???h????????B????K?v??????? if (! $add) {
3112		my $line = qq($in_tm,) . param('in_pass') . qq(,\n);
3113		push(@new_raw_pass,$line);
3114		}
3115		@raw_pass = @new_raw_pass;
3116		}
3117		if ($new_data \|\| $raw_pass) {
3118		my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
3119		open(RAW,">$raw_pass_path");
3120		print RAW @raw_pass;
3121		close(RAW);
3122		}
3123		if (param('del') eq '?o?^????') {
3124		my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
3125		my @raw_pass_list = &read_file($raw_pass_path);
3126		open(RAW,">$raw_pass_path");
3127		foreach (@raw_pass_list) {
3128		if ((split(/,/))[0] != param('in_tm')) { print RAW $_; }
3129		}
3130		close(RAW);
3131		}
3132		if ($use_htaccess) {
3133		if (param('del') eq '?o?^????') {
3134		if (-e $pass_file_path) {
3135		if (open(PAS,"$pass_file_path")) {
3136		my @pass_list = <PAS>;
3137		close(PAS);
3138		my @new_pass_list = ();
3139		foreach (@pass_list) {
3140		my ($id,$pass) = split(/:/);
3141		if ($id ne $in_user) {
3142		push(@new_pass_list,$_);
3143		}
3144		}
3145		if (@new_pass_list) {
3146		open(PAS,">$pass_file_path");
3147		print PAS @new_pass_list;
3148		close(PAS);
3149		} else {
3150		unlink $pass_file_path;
3151		}
3152		}
3153		}
3154		foreach (@child_user_list) {
3155		my $tmp_path = $path{"$_"};
3156		$tmp_path =~ s/^\.\///;
3157		my $pass_file_path = join('/',$passdir,$tmp_path,'.htpasswd');
3158		if (-e $pass_file_path) {
3159		if (open(PAS,"$pass_file_path")) {
3160		my @pass_list = <PAS>;
3161		close(PAS);
3162		my @new_pass_list = ();
3163		foreach (@pass_list) {
3164		my ($id,$pass) = split(/:/);
3165		if ($id ne $in_user) {
3166		push(@new_pass_list,$_);
3167		}
3168		}
3169		if (@new_pass_list) {
3170		open(PAS,">$pass_file_path");
3171		print PAS @new_pass_list;
3172		close(PAS);
3173		} else {
3174		unlink $pass_file_path;
3175		}
3176		}
3177		}
3178		}
3179		#?v????o?^?????????????A???[?g?f?B???N?g????w??????[?U?[????????f?B???N?g????A.htaccess?t?@?C?????????B
3180		my $del_htac = $del_htac{"$in_user"};
3181		if ($del_htac && ! $use_htac{"$del_htac"}) {
3182		if (unlink join('/',$del_htac{"$in_user"},$htaccess)) {
3183		$comment .= qq(<div style="color:red"><strong>) . join('/',$del_htac{"$in_user"},$htaccess) . qq(</strong>?????????B</div>);
3184		}
3185		my $tmp = $del_htac{"$in_user"};
3186		$tmp =~ s/^\.\///;
3187		if (unlink join('/',$passdir,$tmp,'.htpasswd')) {
3188		$comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>?????????B</div>);
3189		}
3190		}
3191		} else { # ???E?????
3192
3193		# $pass_file_path??D??p?X???h????????B
3194		# ???????huser,$hpass??parent_user_list?????[?U?[??D??p?X???h
3195		# @parent_user_list?????[?U?[????[?g?f?B???N?g????$path{"$_"}?B
3196		# ?p?X???h???t?@?C????join('/',$passdir,$path{"$_"},'.htpasswd')????B
3197		# ????J?????[?U?[?????????????p?X???h????B
3198		my (@pass_list);
3199		foreach my $user (@parent_user_list) {
3200		next if $user =~ /^\s+$/; # ??s??
3201		push(@pass_list, qq($user:$pass{"$user"})) if $user ne $in_user;
3202		}
3203		push(@pass_list,qq($in_user:$in_pass));
3204		push(@pass_list,qq($admin_id:$adminpass)); # ???????D??p?X???? my $tmp_path = $in_path;
3205		$tmp_path =~ s/^\.\///;
3206		open(NEW,'>' . join('/',$passdir,$tmp_path,'.htpasswd'));
3207		foreach (@pass_list) {
3208		print NEW $_ . "\n";
3209		}
3210		close(NEW);
3211
3212		# ??w?f?B???N?g?????p?X???h??? @dir_list = ();
3213		&get_subdir(join('/',$passdir,$tmp_path));
3214		foreach my $path (@dir_list) {
3215		my $tmp_path = $path;
3216		$tmp_path =~ s/^\.\///;
3217		if (open(PAS,join('/',$path,'.htpasswd'))) {
3218		my @pass_list = <PAS>;
3219		close(PAS);
3220		my (@new_pass_list);
3221		my $add = 1;
3222		foreach my $line (@pass_list) {
3223		next if $line =~ /^\s+$/; # ??s??
3224		chomp $line;
3225		my list($id,$pass) = explode(':',$line);
3226		if ($id eq $in_user) {
3227		$line = qq($in_user:$in_pass);
3228		$add= 0;
3229		}
3230		push(@new_pass_list,$line);
3231		}
3232		if ($add) {
3233		push(@new_pass_list,qq($in_user:$in_pass));
3234		}
3235		open(PAS,">" . join('/',$path,'.htpasswd'));
3236		foreach (@new_pass_list) {
3237		print PAS $_ . "\n";
3238		}
3239		close(PAS);
3240		}
3241		}
3242		}
3243		}
3244
3245		#### user.cgi???e???????s?v??t?@?C????????
3246		my (%set_htac, %path_);
3247		foreach my $line (@new_user) {
3248		my list($tm, $user, $path, $pass, $permit, $l_size, $mail) = explode('\,',$line);
3249		$user = &rechange($user);
3250		$set_htac{"$path"} = 1;
3251		$path_{"$user"} = $path
3252		}
3253		@dir_list = ();
3254		&get_subdir($updir);
3255		unshift(@dir_list,$updir);
3256		foreach my $dir (@dir_list) {
3257		if (-e join('/',$dir,$htaccess) && ! $set_htac{"$dir"}) {
3258		if (unlink join('/',$dir,$htaccess)) {
3259		$comment .= qq(<div style="color:red"><strong>) . join('/',$dir,$htaccess) . qq(</strong>?????????/div>\n);
3260		} else {
3261		$comment .= qq(<div style="color:red"><strong>) . join('/',$dir,$htaccess) . qq(</strong>?????????????/div>\n);
3262		}
3263		}
3264		my $tmp = $dir;
3265		$tmp =~ s/^\.\///;
3266		if (-e join('/',$passdir,$tmp,'.htpasswd')) {
3267		if (! $set_htac{"$dir"}) {
3268		if (unlink join('/',$passdir,$tmp,'.htpasswd')) {
3269		$comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>?????????/div>\n);
3270		} else {
3271		$comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>?????????????/div>\n);
3272		}
3273		} else {
3274		if (open(HTPAS,join('/',$passdir,$tmp,'.htpasswd'))) {
3275		my @pass_list = <HTPAS>;
3276		close(HTPAS);
3277		my @new_pass_list = ();
3278		foreach (@pass_list) {
3279		my ($id, $pass) = split(/:/);
3280		if (index($dir,$path_{"$id"}) < 0) {
3281		$comment .= qq(<div style="color:red">) . join('/',$passdir,$tmp,'.htpasswd') . qq(??{id}?????????B</div>\n);
3282		} else {
3283		push(@new_pass_list,$_);
3284		}
3285		}
3286		open(HTPAS,">" . join('/',$passdir,$tmp,'.htpasswd'));
3287		print HTPAS @new_pass_list;
3288		close(HTPAS);
3289		}
3290		}
3291		}
3292		}
3293		&unlock();
3294		} elsif (param('new_user')) {
3295		$comment .= qq(<div style="color:red">???[?U?[????L????B</div>\n);
3296		}
3297		my (@user, @raw_pass);
3298		@user = &read_file("./user.cgi");
3299		@raw_pass = &read_file(join('/',$passdir,'raw_pass.cgi'));
3300		my $html;
3301		if (param('show_log')) {
3302		my $log_path = join('/',$access_dir,param('show_log') . '.cgi');
3303		if (open(LOG,"$log_path")) {
3304		my @log = <LOG>;
3305		close(LOG);
3306		my $user = &rechange((split(/\,/,$log[0]))[0]);
3307
3308		$html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="?A?N?Z?X???O">\n);
3309		$html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>??A?N?Z?X???O</caption>\n);
3310		$html .= qq(<tr><th>?A?N?Z?X???/th><th>?z?X?g</th></tr>\n);
3311		@log =reverse @log;
3312		foreach (@log) {
3313		my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3314		$ax_tm =~ s/(\(??))/<span style="color:red">$1<\/span>/;
3315		$ax_tm =~ s/($?y$)/<span style="color:blue">$1<\/span>/;
3316		$html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3317		}
3318		$html .= qq(</table>\n</div>\n);
3319		}
3320		my $log_patht = $log_path;
3321		$log_patht =~ s/(\.cgi$)/t$1/;
3322		if (open(LOG,"$log_patht")) {
3323		my @log = <LOG>;
3324		close(LOG);
3325		my $user = &rechange((split(/\,/,$log[0]))[0]);
3326		$html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="?A?N?Z?X???O">\n);
3327		$html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>??A?N?Z?X???O</caption>\n);
3328		$html .= qq(<tr><th>?A?N?Z?X???/th><th>?z?X?g</th></tr>\n);
3329		@log = reverse @log;
3330		foreach (@log) {
3331		my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3332		$ax_tm =~ s/(\(??))/<span style="color:red">$1<\/span>/;
3333		$ax_tm =~ s/($?y$)/<span style="color:blue">$1<\/span>/;
3334		$html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3335		}
3336		$html .= qq(</table>\n</div>\n);
3337		}
3338		my $log_pathg = $log_path;
3339		$log_pathg =~ s/(\.cgi$)/g$1/;
3340		if (open(LOG,"$log_pathg")) {
3341		my @log = <LOG>;
3342		close(LOG);
3343		my $user = &rechange((split(/\,/,$log[0]))[0]);
3344		$html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="?A?N?Z?X???O">\n);
3345		$html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>??A?N?Z?X???O</caption>\n);
3346		$html .= qq(<tr><th>?A?N?Z?X???/th><th>?z?X?g</th></tr>\n);
3347		@log = reverse @log;
3348		foreach (@log) {
3349		my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3350		$ax_tm =~ s/(\(??))/<span style="color:red">$1<\/span>/;
3351		$ax_tm =~ s/($?y$)/<span style="color:blue">$1<\/span>/;
3352		$html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3353		}
3354		$html .= qq(</table>\n</div>\n);
3355		}
3356		if (! $html) {
3357		$html = '???O????????;
3358		}
3359		return $html;
3360		}
3361		my ($time_sort, $name_sort, $dir_sort, $mail_sort,$acc_sort,%order,$tindx, %time, %host);
3362		my $page = param('page');
3363		$time_sort = 'time';
3364		$order{'time'} = '(?~?';
3365		$name_sort = 'name';
3366		$order{'name'} = '(?~?';
3367		$dir_sort = 'dir';
3368		$order{'dir'} = '(?~?';
3369		$mail_sort = 'mail';
3370		$order{'mail'} = '(?~?';
3371		$acc_sort = 'acc';
3372		$order{'acc'} = '(?~?';
3373		if ($sort =~ /^time/) {
3374		if ($sort eq 'time') {
3375		$time_sort = 'time_r';
3376		$order{'time'} = '(??)';
3377		}
3378		}
3379		if ($sort =~ /^name/) {
3380		if ($sort eq 'name') {
3381		$name_sort = 'name_r';
3382		$order{'name'} = '(??)';
3383		}
3384		}
3385		if ($sort =~ /^dir/) {
3386		if ($sort eq 'dir') {
3387		$dir_sort = 'dir_r';
3388		$order{'dir'} = '(??)';
3389		}
3390		}
3391		if ($sort =~ /^mail/) {
3392		if ($sort eq 'mail') {
3393		$mail_sort = 'mail_r';
3394		$order{'mail'} = '(??)';
3395		}
3396		}
3397		if ($sort =~ /^acc/) {
3398		if ($sort eq 'acc') {
3399		$acc_sort = 'acc_r';
3400		$order{'acc'} = '(??)';
3401		}
3402		}
3403
3404		$tindx = 0;
3405		my ($fuser,$fpath,$fpass,$fpermit,$fl_size,$fkl_size,$ftm,$fmail,$fauto_del,$fmax_dl);
3406		foreach (@user) {
3407		my ($tm, $user, $path, $pass, $permit, $l_size, $mail,$auto_del,$max_dl) = split/\,/;
3408		if (param("$tm") \|\| param('in_tm') eq $tm) {
3409		$user = &rechange($user);
3410		$ftm = $tm;
3411		$fuser =$user;
3412		$fpath = $path;
3413		$fmail = $mail;
3414		$fpass = $pass;
3415		$fpermit = $permit;
3416		$fl_size = $l_size;
3417		$fkl_size = int($l_size / (1024 * 1024));
3418		$fauto_del = $auto_del;
3419		$fmax_dl = $max_dl;
3420		}
3421		}
3422		my ($button, $table_col);
3423		my ($auto_pass, $passcom, $auto_pass_com,$auto_path_str);
3424		my $active_col = '#ffffbb';
3425		if (param('auto_pass') \|\| param('auto_pass_re')) {
3426		my ($al,$dg,$mk,$length,$al_chk,$dg_chk,$mk_chk,$hidden);
3427		$length = param('length');
3428		if (param('auto_pass')) {
3429		$al = 1;
3430		$dg = 1;
3431		$mk = 1;
3432		$length = $pass_length + 2;
3433		} elsif (param('auto_pass_re')) {
3434		$al = param('al');
3435		$dg = param('dg');
3436		$mk = param('mk');
3437		$al = 1 if ! $al && ! $dg && !$mk;
3438		}
3439		$auto_path_str = '?p?X???h????;
3440		$al_chk = qq( checked="checked") if $al;
3441		$dg_chk = qq( checked="checked") if $dg;
3442		$mk_chk = qq( checked="checked") if $mk;
3443		$auto_pass = &auto_pass($length,$al,$dg,$mk);
3444		$auto_pass_com = qq(<br /><input type="submit" name="auto_pass_re" value="$auto_path_str" style="font-size:80%" /><br />);
3445		my $length_com = qq(<select name="length">\n);
3446		for (my $i=$pass_length; $i <= ($pass_length + 10); $i++) {
3447		my $sel;
3448		if ($length == $i) {
3449		$sel = qq( selected="selected");
3450		}
3451		$length_com .= qq(<option value="$i"$sel>$i</option>);
3452		}
3453		$length_com .= qq(</select>???);
3454		$auto_pass_com .= qq(<input type="checkbox" name="al"$al_chk value="1" />?p <input type="checkbox" name="dg"$dg_chk value="1" />?? <input type="checkbox" name="mk"$mk_chk value="1" />?L??$length_com<br />);
3455		} else {
3456		$auto_pass_com = qq(<br /><input type="submit" name="auto_pass" value="?p?X???h???????? style="font-size:80%" />);
3457		}
3458		my $reset;
3459		$reset = 1 if param('new_user') \|\| param('modify') \|\| param('del');
3460		my @perm = (' checked="checked"',' checked="checked"','','');
3461		if ($fpermit && ! $reset) {
3462		my $j = 0;
3463		for(my $i = 1; $i <= 8; $i *= 2){
3464		if($fpermit & $i){
3465		$perm[$j] = ' checked="checked"';
3466		} else {
3467		$perm[$j] = '';
3468		}
3469		$j++;
3470		}
3471		}
3472		my $limit_size = 1024 * 1024 * $max_mb;
3473		my $k_limit_size = int($limit_size / (1024 * 1024));
3474		if (($ftm \|\| param('in_tm')) && ! $reset) {
3475		$k_limit_size = $fkl_size;
3476		$tindx++;
3477		$button .= qq(<input type="submit" name="modify" value="????o?^??C?? tabindex="$tindx" /> ); $tindx++;
3478		$button .= qq(<input type="submit" name="del" value="?o?^????" tabindex="$tindx" />); $tindx++;
3479		$table_col = qq(background-color:$active_col);
3480		$passcom = qq(<br /><span style="font-size:80%;color:red">?p?X???h???X????????????????/span>);
3481		} else {
3482		$tindx++;
3483		$button .= qq(<input type="submit" name="new_user" value="?????e???? tabindex="$tindx" />); $tindx++;
3484		$fpath = $root . '/root';
3485		}
3486		my $max_size_tab = $tindx;
3487		$fuser = param('in_user') if param('in_user') && ! $reset;
3488		$fpath = param('in_path') if param('in_path') && ! $reset;
3489		$fmail = param('in_mail') if param('in_mail') && ! $reset;
3490		$k_limit_size = param('in_size') if param('in_size');
3491		$fuser = $fmail = $ftm = '' if $reset;
3492		$perm[2] = ' checked="checked"' if param('permission');
3493		$perm[3] = ' checked="checked"' if param('cgi');
3494		my $fuser_length = length($fuser) * 1.2;
3495		my $fpath_size = length($fpath);
3496		$fpath_size = qq( size=") . int($fpath_size * 1.6) . qq(") if $fpath_size;
3497		my $pass_size = length($auto_pass);
3498		$pass_size = 16 if $pass_size < 16;
3499		$pass_size = qq( size=") . int($pass_size * 1.2) . qq(") if $pass_size;
3500		my $usr_form;
3501		$usr_form .= qq(<div style="padding:0.5em"><a name="anchor" id="anchor" style="padding:0.5em"> </a>$comment</div>\n) if $comment;
3502		$usr_form .= qq(<div style="padding:0.5em">$send_mail_link</div>\n) if $send_mail_link;
3503		my %param = ('login_admin'=>$login_admin,'mode'=>$mode,'mode2'=>'user','in_tm'=>$ftm,'page'=>$page);
3504		my $hidden = &hidden_param(%param);
3505		$usr_form .= << "___USERFORM___";
3506		<form action="${script}#anchor" method="post" style="margin:0">
3507		$hidden
3508		<table border="1" cellpadding="4" cellspacing="0" style="margin:4px 0 4px 0;$table_col" summary="???[?U?[???t?H?[??">
3509		___USERFORM___
3510		if (param('auto_pass') \|\| param('auto_pass_re')) {
3511		$usr_form .= qq(<caption style="text-align:left;"><a name="anchor" id="anchor" style="padding:0.5em">???[?U?[???t?H?[??</a></caption>);
3512		} else {
3513		$usr_form .= qq(<caption style="text-align:left;"><a name="input" id="input" style="padding:0.5em">???[?U?[???t?H?[??</a></caption>);
3514		}
3515		$usr_form .= qq( <tr>\n <th colspan="2">$button<input type="reset" value="???Z?b?g" tabindex="$tindx" /></th>\n </tr>\n); $tindx++;
3516		$usr_form .= qq( <tr>\n <th>???[?U?[??/th>\n <td><input type="text" size="$fuser_length" name="in_user" value="$fuser" tabindex="$tindx" />\n</td>\n </tr>\n); $tindx++;
3517		$usr_form .= qq( <tr>\n <th>?p?X???h</th>\n <td><input type="text" name="in_pass" value="$auto_pass" style="ime-mode:disabled;" tabindex="$tindx"$pass_size />$passcom\n);
3518		$usr_form .= qq($auto_pass_com</td>\n </tr>\n); $tindx++;
3519		$usr_form .= qq( <tr>\n <th>?f?B???N?g??</th>\n <td><input type="text"$fpath_size name="in_path" value="$fpath" style="ime-mode:disabled;" tabindex="$tindx" /><br /><span style="font-size:80%">(????????f?B???N?g?????A?N?Z?X??????</span></td>\n </tr>\n); $tindx++;
3520		$usr_form .= qq( <tr>\n <th><span style="white-space:nowrap;">???[???A?h???X</span></th>\n <td><input type="text" size="24" name="in_mail" value="$fmail" style="ime-mode:disabled;" tabindex="$tindx" /></td>\n </tr>\n); $tindx++;
3521		$usr_form .= qq( <tr>\n <th>?????????/th>\n <td>);
3522		$usr_form .= qq(<input type="checkbox" name="upload" value="1"$perm[0] tabindex="$tindx" />???span style="font-size:80%"> \(?t?@?C????A?b?v???[?h?A?f?B???N?g??????)</span><br />\n); $tindx++;
3523		$usr_form .= qq(<input type="checkbox" name="delete" value="1"$perm[1] tabindex="$tindx" />???<span style="font-size:80%"> $?t?@?C???A?f?B???N?g??????$</span><br />\n); $tindx++;
3524		$usr_form .= qq(<input type="checkbox" name="permission" value="1"$perm[2] tabindex="$tindx" />?????X<br />\n); $tindx++;
3525		my $pex = '';
3526		if ($prohibit_ext) {
3527		my list($ex1,$ex2) = explode('\,',$prohibit_ext);
3528		$pex = qq(<span style="font-size:80%"> $<strong>.${ex1}</strong>?A<strong>.${ex2}</strong>????g??q??t?@?C??$ </span>);
3529		}
3530		$usr_form .= qq(<input type="checkbox" name="cgi" value="1"$perm[3] tabindex="$tindx" />??~?t?@?C??$pex?????/td>\n </tr>\n); $tindx++;
3531		$usr_form .= qq( <tr>\n <th>?e????/th>\n <td><input type="text" size="12" name="in_size" value="$k_limit_size" style="ime-mode:disabled;" tabindex="$tindx" /> MB <span style="font-size:80%">\(0??????)</span></td>\n </tr>\n); $tindx++;
3532		$usr_form .= qq(</table>\n</form>\n);
3533
3534		my @access = &read_file($access);
3535		my (@acc_list,%acc_ord);
3536		if($save_log){
3537		foreach(@access){
3538		my($ac_user, $ac_time, $ac_host,$reg_tm) = split(/\,/);
3539		$time{"$reg_tm"} = $ac_time if !$time{"$reg_tm"};
3540		$host{"$reg_tm"} = $ac_host if !$host{"$reg_tm"};
3541		$ac_user =~ s/$.+$$//;
3542		push(@acc_list,$ac_user) if $ac_user ne $admin_id;
3543		}
3544		@acc_list = &get_unique(@acc_list);
3545		my $i = 0;
3546		foreach (@acc_list) {
3547		$acc_ord{"$_"} = $i++;
3548		}
3549		# ?A?N?Z?X???O??????????[?U?[???????? foreach (@user) {
3550		my $usr = (split(/\,/))[1];
3551		if (! exists $acc_ord{"$usr"}) {
3552		$acc_ord{"$usr"} = $i++;
3553		}
3554		}
3555		}
3556		my $total_size = &size_measure($root);
3557		my $usr_nmb = scalar(@user);
3558		my $usr_nmb_com;
3559		$usr_nmb_com = '<a name="user_index" id="user_index" style="padding:0.5em">?o?^????????[?U?[</a> <strong>' . $usr_nmb . "?l</strong>  \n";
3560		$usr_nmb_com .= qq(<table summary="?o?^????C???f?b?N?X"><tr>\n);
3561		$page = 0 if ! $page;
3562		if ($usr_nmb > $max_user) {
3563		my $lft = $page * $max_user + 1;
3564		my $rgt = ($page + 1) * $max_user;
3565		$rgt = $usr_nmb if $rgt > $usr_nmb;
3566		my $end_page = int($usr_nmb / $max_user);
3567		for (my $i = 0; $i <= $end_page; $i++) {
3568		my $start = $i * $max_user + 1;
3569		next if $start > $usr_nmb;
3570		my $end = ($i + 1) * $max_user;
3571		my $sort = param('sort');
3572		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'user','sort'=>$sort,'page'=>$i);
3573		my $link = qq($script) . &url_param(%param) . qq(#user_index);
3574		$end = $usr_nmb if $end > $usr_nmb;
3575		if (param('page') == $i) {
3576		if ($start == $end) {
3577		if ($post_only) {
3578		$usr_nmb_com .= qq(<td><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$start" style="color:red" /></form></td>);
3579		} else {
3580		$usr_nmb_com .= qq(<td>[<a href="$link" style="color:red">$start</a>] </td>);
3581		}
3582		} else {
3583		if ($post_only) {
3584		$usr_nmb_com .= qq(<td><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$start?`$end" style="color:red" /></form></td>);
3585		} else {
3586		$usr_nmb_com .= qq(<td>[<a href="$link" style="color:red">$start?`$end</a>] </td>);
3587		}
3588		}
3589		} else {
3590		if ($start == $end) {
3591		if ($post_only) {
3592		$usr_nmb_com .= qq(<td><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$start" /></form></td>);
3593		} else {
3594		$usr_nmb_com .= qq(<td>[<a href="$link">$start</a>] </td>);
3595		}
3596		} else {
3597		if ($post_only) {
3598		$usr_nmb_com .= qq(<td><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$start?`$end" /></form></td>);
3599		} else {
3600		$usr_nmb_com .= qq(<td>[<a href="$link">$start?`$end</a>] </td>);
3601		}
3602		}
3603		}
3604		}
3605		}
3606		$usr_nmb_com .= qq(</tr></table>\n);
3607		$total_size = &kiro_byte($total_size);
3608		my $add_input;
3609		# ???[?U?[??w??????[?U?[???????[?U?[???t?H?[????\??????????
3610		if ($ftm) {
3611		$add_input = qq(<caption style="text-align:left;">\n);
3612		$add_input .= qq(<form action="$script" method="post" style="margin:0">\n);
3613		$add_input .= qq(<input type="hidden" name="mode" value="$mode">\n);
3614		$add_input .= qq(<input type="hidden" name="mode2" value="user">\n);
3615		$add_input .= qq(<input type="hidden" name="login_admin" value="$login_admin">\n);
3616		$add_input .= qq(<input type="hidden" name="sort" value="$sort">\n);
3617		$add_input .= qq(<input type="hidden" name="page" value="$page">\n);
3618		$add_input .= qq(<input type="submit" name="new" value="?V?K???[?U?[???? tabindex="$tindx" />\n);
3619		$add_input .= qq(</form>\n);
3620		$add_input .= qq(</caption>\n); $tindx++;
3621		}
3622		my $search = qq(<form action="${script}#user_index" method="post">\n
3623		<input type="hidden" name="mode" value="$mode" />
3624		<input type="hidden" name="mode2" value="user" />
3625		<input type="hidden" name="login_admin" value="$login_admin" />
3626		<input type="hidden" name="sort" value="$sort" />);
3627		my $key;
3628		$key = param('key') if ! param('clear');
3629		$search .= qq(<input type="text" name="key" value="$key" /> <input type="submit" name="search" value="???[?U?[????? /> <input type="submit" name="clear" value="?N???A" /></form>\n);
3630		if (param('search') && param('key')) {
3631		$usr_nmb_com = '<hit_count>';
3632		}
3633		my $hid;
3634		if ($key) {
3635		$hid .= qq(<input type="hidden" name="key" value="$key" />\n);
3636		$hid .= qq(<input type="hidden" name="search" value="1" />\n);
3637		}
3638		my $raw_pass_alarm;
3639		if (scalar(@raw_pass)) {
3640		if (scalar(@raw_pass) < scalar(@user)) {
3641		$raw_pass_alarm = qq(??p?X???h????????????[?U?[?????B);
3642		}
3643		} else {
3644		if (! -e join('/',$passdir,'raw_pass.cgi') && scalar(@user) > 0) {
3645		$raw_pass_alarm = qq(??p?X???h???????????B);
3646		} elsif (scalar(@user) > 0) {
3647		$raw_pass_alarm = qq(??p?X???h????????????[?U?[?????B);
3648		}
3649		}
3650		my $edit_form =<<"EOF";
3651		<form action="${script}#input" method="post" style="margin:0;padding:0">
3652		<input type="hidden" name="mode" value="$mode" />
3653		<input type="hidden" name="mode2" value="user" />
3654		<input type="hidden" name="login_admin" value="$login_admin" />
3655		<input type="hidden" name="sort" value="$sort" />
3656		<input type="hidden" name="page" value="$page" />
3657		$hid
3658		EOF
3659		$html .= << "EOF";
3660		$usr_nmb_com$search
3661		<span style="color:red">$raw_pass_alarm</span>
3662		<table border="1" cellpadding="4" cellspacing="0" style="margin:4px 0 4px 0;font-size:90%" summary="?o?^????????[?U?[">
3663		$add_input
3664		<tr>
3665		<th rowspan="2"> </th>
3666		EOF
3667		undef %param;
3668		%param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$time_sort,'mode2'=>'user');
3669		if ($post_only) {
3670		$html .= qq(<th rowspan="2"><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?o?^???" title="?o?^?????\\?[?g$order{'time'}" /></form></th>\n);
3671		} else {
3672		$html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="?o?^?????\\?[?g$order{'time'}">?o?^???</a></th>);
3673		}
3674		$param{'sort'} = $name_sort;
3675		if ($post_only) {
3676		$html .= qq(<th rowspan="2"><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???[?U?[?? title="???[?U?[???\\?[?g$order{'name'}" /></form></th>\n);
3677		} else {
3678		$html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="???[?U?[???\\?[?g$order{'name'}">???[?U?[??/a></th>\n);
3679		}
3680		$param{'sort'} = $dir_sort;
3681		if ($post_only) {
3682		$html .= qq(<th rowspan="2"><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?f?B???N?g??" title="?f?B???N?g?????\\?[?g$order{'dir'}" /></form></th>\n);
3683		} else {
3684		$html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="?f?B???N?g?????\\?[?g$order{'dir'}">?f?B???N?g??</a></th>\n);
3685		}
3686		$param{'sort'} = $mail_sort;
3687		if ($post_only) {
3688		$html .= qq(<th rowspan="2"><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="???[???A?h???X" title="???[???A?h???X??\\?[?g$order{'mail'}" /></form></th>\n);
3689		} else {
3690		$html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="???[???A?h???X??\\?[?g$order{'mail'}">???[???A?h???X</a></th>\n);
3691		}
3692		$param{'sort'} = $acc_sort;
3693		my $colplus;
3694		if ($post_only) {
3695		$colplus .= qq(<th rowspan="2"><form action="${script}#user_index" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="??I?A?N?Z?X??? title="??I?A?N?Z?X????\\?[?g$order{'acc'}" /></form></th>\n);
3696		} else {
3697		$colplus .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="??I?A?N?Z?X????\\?[?g$order{'mail'}">??I?A?N?Z?X???/a></th>\n);
3698		}
3699		$colplus .= qq(<th rowspan="2">?z?X?g</th>\n);
3700		$html .= << "EOF";
3701		<th rowspan="2">?e?????e??br /><span style="font-size:80%">(?e????v$total_size)</span></th>
3702		<th colspan="4">?????????/th>$colplus
3703		<th rowspan="2">?p?X???h</th>
3704		</tr>
3705		<tr>
3706		<td><span style="font-size:-1"><a title="?t?@?C????A?b?v???[?h?A?f?B???N?g??????>???/a></span></td>
3707		<td><span style="font-size:-1"><a title="?f?B???N?g???A?t?@?C??????">???</a></span></td>
3708		<td><span style="font-size:-1"><a title="?f?B???N?g???A?t?@?C????p?[?~?b?V??????X">???/a></span></td>
3709		<td><span style="font-size:-1"><a title="??~?t?@?C????A?b?v???[?h">??~</a></span></td>
3710		</tr>
3711		EOF
3712		my (@updir_list, %dir_user, %tm);
3713		$sort = 'time_r' if ! $sort;
3714		if ($sort eq 'time') {
3715		@user = map {$_->[0]} sort {$a->[1] cmp $b->[1]} map {[$_, split /\,/]} @user;
3716		} elsif ($sort eq 'time_r') {
3717		@user = map {$_->[0]} sort {$b->[1] cmp $a->[1]} map {[$_, split /\,/]} @user;
3718		} elsif ($sort eq 'name') {
3719		@user = map {$_->[0]} sort {$a->[2] cmp $b->[2]} map {[$_, split /\,/]} @user;
3720		} elsif ($sort eq 'name_r') {
3721		@user = map {$_->[0]} sort {$b->[2] cmp $a->[2]} map {[$_, split /\,/]} @user;
3722		} elsif ($sort eq 'dir') {
3723		@user = map {$_->[0]} sort {$a->[3] cmp $b->[3]} map {[$_, split /\,/]} @user;
3724		} elsif ($sort eq 'dir_r') {
3725		@user = map {$_->[0]} sort {$b->[3] cmp $a->[3]} map {[$_, split /\,/]} @user;
3726		} elsif ($sort eq 'mail') {
3727		@user = map {$_->[0]} sort {$a->[7] cmp $b->[7]} map {[$_, split /\,/]} @user;
3728		} elsif ($sort eq 'mail_r') {
3729		@user = map {$_->[0]} sort {$b->[7] cmp $a->[7]} map {[$_, split /\,/]} @user;
3730		} elsif ($sort eq 'acc') {
3731		@user = map {$_->[0]} sort {$acc_ord{$a->[2]} <=> $acc_ord{$b->[2]}} map {[$_, split /\,/]} @user;
3732		} elsif ($sort eq 'acc_r') {
3733		@user = map {$_->[0]} sort {$acc_ord{$b->[2]} <=> $acc_ord{$a->[2]}} map {[$_, split /\,/]} @user;
3734		}
3735
3736		my $ad_pass = $pass;
3737		my $user_count = 0;
3738		my $hit_count = 0;
3739		my %rpass;
3740		foreach (@raw_pass) {
3741		my ($tm,$rpass) = split(/\,/);
3742		$rpass{"$tm"} = $rpass;
3743		}
3744
3745		my @login_list;
3746		opendir(DIR,$logindir);
3747		while (my $file=readdir(DIR)) {
3748		next if $file !~ /\w{10}\.cgi$/;
3749		my $path = join('/',$logindir,$file);
3750		open(GID,$path);
3751		my $id =<GID>;
3752		chomp $id;
3753		close(GID);
3754		push(@login_list,$id);
3755		}
3756		closedir(DIR);
3757
3758		my $ascii = '[\x00-\x7F]';
3759		my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
3760		my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
3761		foreach(@user){
3762		my ($euc,$key);
3763		if (param('search') && param('key')) {
3764		$key = param('key');
3765		$euc = $_;
3766		if ($encode_lib == 1) {
3767		eval 'use Jcode;';
3768		Jcode::convert(\$euc, "euc");
3769		Jcode::convert(\$key, "euc");
3770		} else {
3771		require 'jcode.pl';
3772		&jcode::convert(\$euc, "euc");
3773		&jcode::convert(\$key, "euc");
3774		}
3775
3776		# ????????}?b?`?????????? if ($euc !~ /^(?:$ascii\|$twoBytes\|$threeBytes)*?(?:$key)/) {
3777		$user_count++;
3778		next;
3779		} else {
3780		$hit_count++;
3781		}
3782		}
3783		my ($tm, $user, $path, $pass, $permit, $l_size, $mail) = split/\,/, $_;
3784		$user = &rechange($user);
3785		push(@updir_list,$path);
3786		$dir_user{"$path"} .= qq($user,);
3787		$tm{"$path"} = $tm;
3788		if (!(param('search') && param('key')) && ($user_count < $page * $max_user \|\| $user_count >= ($page + 1) * $max_user)) {
3789		$user_count++;
3790		next;
3791		}
3792		my $msg = my $col_col = my $active = '';
3793		if (param("$tm") \|\| param('in_tm') eq $tm) {
3794		$col_col = qq( style="background-color:$active_col");
3795		$active = 1;
3796		} elsif ($path =~ /$user_root/) {
3797		$col_col = qq( style="background-color:$zebra_back_col");
3798		}
3799		my $login;
3800		foreach (@login_list) {
3801		if ($user eq $_) {
3802		$col_col = qq( style="background-color:#ffccee") if ! $active;
3803		$login = qq(<span style="font-size:80%;color:red"> ???O?C????</span>);
3804		last;
3805		}
3806		}
3807		$msg .= qq(<tr$col_col>\n<td style="text-align:right;">$edit_form<input type="submit" name="$tm" value="??W) . ($user_count + 1) . qq(" tabindex="$tindx" /></form></td>\n); $tindx++;
3808		my ($sec, $min, $hour, $day, $mon, $year) = localtime($tm);
3809		$year+=1900;
3810		$mon++;
3811		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
3812		$msg .= qq(<td><span style="font-size:80%">$tm_com</span></td>\n);
3813
3814		# ?o?^???[?U?[??????O?C??????????[?U?[??d??t?H?[???p?p?????[?^???? my %param = ('mode'=>'login','dptid'=>$user);
3815		$msg .= qq(<td><table summary="???[?U?[??????O?C??"><tr><td><form action="$script" method="post" style="margin:0;padding:0" target="_blank">) . &hidden_param(%param) . qq(<input type="image" src="./img/men.gif" alt="${user}${mr}??????O?C??" /></form></td><td>) . &key_color($user,$key) . qq($login</td></tr></table></td>\n);
3816		undef %param;
3817		%param = ('login_admin'=>$login_admin,'dir'=>$path);
3818		if ($post_only) {
3819		$msg .= qq(<td><table summary="?f?B???N?g?????><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/dir.gif" alt="${user}${mr}??f?B???N?g?????? /></form></td><td>) .&key_color($path,$key) . qq(</td></tr></table></td>\n);
3820		} else {
3821		my $url = qq($script) . &url_param(%param);
3822		$msg .= qq(<td><table summary="?f?B???N?g?????><tr><td><a href="$url" title="${user}${mr}??f?B???N?g??????><span style=""><img border="0" src="./img/dir.gif" alt="${user}${mr}??f?B???N?g?????? /></span></a></td><td><a href="$url" title="${user}${mr}??f?B???N?g??????>) . &key_color($path,$key) . qq(</a></td></tr></table></td>\n);
3823		}
3824		if ($mail) {
3825		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$tm);
3826		if ($post_only) {
3827		$msg .= qq(<td><table summary="???[?????M"><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/mail.gif" alt="${user}${mr}????[??????? /></form></td><td>) .&key_color($mail,$key) . qq(</td></tr></table></td>\n);
3828		} else {
3829		my $url = qq($script) . &url_param(%param);
3830		$msg .= qq(<td><table summary="???[?????M"><tr><td><a href="$url" title="${user}${mr}????[???????><img border="0" src="./img/mail.gif" alt="${user}${mr}????[??????? /></a></td><td><a href="$url" title="${user}${mr}????[???????>) . &key_color($mail,$key) . qq(</a></td></tr></table></td>\n);
3831		}
3832		} else {
3833		$msg .= qq(<td> </td>\n);
3834		}
3835
3836		#?T?C?Y?\??
3837		my $pre_size = &size_measure("$path");
3838		my $tempsize;
3839		if (-e $path) {
3840		$tempsize = &kiro_byte($pre_size);
3841		} else {
3842		$tempsize = '<span style="color:red;font-size:80%">?f?B???N?g??????????/span>';
3843		}
3844		if ($l_size) {
3845		my $lim_size = $l_size;
3846		my ($style) = '';
3847		if ($pre_size > $lim_size) {
3848		$style = qq( style="color:red;font-weight:bold");
3849		} elsif ($pre_size / $lim_size > 0.8) {
3850		$style = qq( style="color:#dd2200;");
3851		}
3852		$msg .= qq(<td align="right"$style>) . $tempsize . " / " . &kiro_byte($lim_size) . "</td>";
3853		} else {
3854		$msg .= "<td align=\"right\">" . $tempsize . " / ?????/td>";
3855		}
3856		my @perm = &perm_list($permit);
3857		foreach (@perm) {
3858		if ($_) {
3859		$msg .= qq(<td align="center">??</td>\n);
3860		} else {
3861		$msg .= qq(<td align="center">?~</td>\n);
3862		}
3863		}
3864		if (! $time{"$tm"}) {
3865		if (! -e join('/',$access_dir,$tm . '.cgi')) {
3866		$time{"$tm"} = ' ';
3867		} else {
3868		open(LOG, join('/',$access_dir,$tm . '.cgi'));
3869		my @axs = <LOG>;
3870		close(LOG);
3871		my $tmp = pop @axs;
3872		mylist($ac_user, $ac_time, $ac_host,$reg_tm) = explode('\,',$tmp);
3873		$time{"$tm"} = $ac_time;
3874		$host{"$tm"} = $ac_host;
3875		}
3876		}
3877		if (! $host{"$tm"}) {
3878		$host{"$tm"} = ' ';
3879		}
3880		if ($time{"$tm"} ne " ") {
3881		my $sort = param('sort');
3882		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>'user','show_log'=>$tm);
3883		if ($post_only) {
3884		$msg .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value=\"$time{"$tm"}\" style="font-size:80%" /></form></td>\n);
3885		} else {
3886		$msg .= qq(<td><small><a href="$script) . &url_param(%param) . qq(">$time{"$tm"}</a></small></td>);
3887		}
3888		$msg .= qq(<td><small>$host{"$tm"}</small></td>\n);
3889		} else {
3890		$msg .= qq(<td><small>$time{"$tm"}</small></td><td><small>$host{"$tm"}</small></td>\n);
3891		}
3892		my $alarm;
3893		if (! $rpass{"$tm"}) {
3894		$alarm .= qq(??p?X???h NG!<br>);
3895		} else {
3896		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'tm'=>$tm,'show_pass'=>'1');
3897		if ($post_only) {
3898		$alarm .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="******" /></form>\n);
3899		} else {
3900		$alarm .= qq(<a href="$script) . &url_param(%param) . qq(">******</a>);
3901		}
3902		}
3903		if ($use_htaccess) {
3904		if (! -e join('/',$path,$htaccess)) {
3905		$alarm .= qq(${htaccess} NG!<br>);
3906		}
3907		$path =~ /$root(.+$)/;
3908		if (! -e qq($passdir/upload) . $1 . '/.htpasswd') {
3909		$alarm .= qq(.htpasswd NG!);
3910		}
3911		}
3912		$msg .= qq(<td style="text-align:center;"><div style="color:red">$alarm</div></td>\n);
3913		$msg .= qq(</tr>\n);
3914		$html .= $msg;
3915		$user_count++;
3916		}
3917		$html .= qq(</table>\n);
3918		if (param('search') && param('key')) {
3919		if ($hit_count) {
3920		my $hit_com = qq(<span style="color:red"><a name="user_index" id="user_index" style="padding:0.5em">${hit_count}???b?g!</a></span>\n);
3921		$html =~ s/<hit_count>/$hit_com/;
3922		} else {
3923		my $nohit = '???Y???????[?U?[????????????;
3924		$html =~ s/<hit_count>/$nohit/;
3925		}
3926		}
3927		my (@del_list,%comment,$htacc_table);
3928		$usr_nmb_com =~ s/\sname="user_index"\sid="user_index"//;
3929		$html .= $usr_nmb_com;
3930		$htacc_table .= qq(<div style="text-align:left;white-space:nowrap;"><a href="#top" title="?y?[?W?g?b?v??>??/a> \n);
3931		my $sort = param('sort');
3932		my $page_ = param('page');
3933		my %param_ = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>'user','page'=>$page_,'show_htaccess'=>'0');
3934		if (param('show_htaccess')) {
3935		if ($post_only) {
3936		$htacc_table .= qq(<form action="$script#htaccess" method="post" style="margin:0;padding:0" name="htaccess" id="htaccess">) . &hidden_param(%param_) . qq(<input type="submit" value="${htaccess}??htpasswd??B?? /></form></div>\n);
3937		} else {
3938		$htacc_table .= qq(<a name="htaccess" id="htaccess" href="$script) . &url_param(%param_) . qq(#htaccess">$htaccess??htpasswd??B??/a></div>\n);
3939		}
3940		} else {
3941		$param_{'show_htaccess'} = 1;
3942		if ($post_only) {
3943		$htacc_table .= qq(<form action="$script#htaccess" method="post" style="margin:0;padding:0" name="htaccess" id="htaccess">) . &hidden_param(%param_) . qq(<input type="submit" value="${htaccess}??htpasswd??\\????? /></form></div>\n);
3944		} else {
3945		$htacc_table .= qq(<a name="htaccess" id="htaccess" href="$script) . &url_param(%param_) . qq(#htaccess">$htaccess??htpasswd??\\?????/a></div>\n);
3946		}
3947		}
3948		$htacc_table .= qq(<table border="1" cellpadding="4" cellspacing="0" style="margin:4px 0 4px 0" summary="$htaccess??htpasswd"><tr><th>$htaccess</th><th>.htpasswd</th><th>?A?N?Z?X??????[?U?[</th></tr>\n) if param('show_htaccess') && @updir_list;
3949		@updir_list = sort &get_unique(@updir_list);
3950		foreach (@updir_list) {
3951		my $htac_file = join('/',$_,$htaccess);
3952		if (-e $htac_file) {
3953		push(@del_list, $htac_file);
3954		my ($cont,@user);
3955		if (open(HTAC,"$htac_file")) {
3956		my @htac = <HTAC>;
3957		close(HTAC);
3958		foreach (@htac) {
3959		if (/^AuthUserFile\s*(.+)/) {
3960		$cont = $1;
3961		last;
3962		}
3963		}
3964		if (-e $cont) {
3965		if (open(PAS,"$cont")) {
3966		my @id_list = <PAS>;
3967		close(PAS);
3968		foreach (@id_list) {
3969		my($id,$pass) = split(/:/);
3970		if ($id) {
3971		if ($pass) {
3972		push(@user,qq([$id]));
3973		} else {
3974		push(@user,qq(${id}??p?X???h??????);
3975		}
3976		}
3977		}
3978		}
3979		} else {
3980		if ($cont) {
3981		$cont =~ s/^$fullpath/\./;
3982		$cont = qq(<span style="color:red">${cont}????????/span>);
3983		}
3984		push(@user,qq( ))
3985		}
3986		}
3987		$cont =~ s/^$fullpath/\./;
3988		$htacc_table .= qq(<tr><td>${htac_file}</td><td>$cont</td><td>@user</td></tr>\n) if (param('show_htaccess'));
3989		} else {
3990		$dir_user{"$_"} =~ s/,$//;
3991		my @dir_user = split(/,/,$dir_user{"$_"});
3992		my $com;
3993		if (@dir_user) {
3994		if (scalar(@dir_user) > 1) {
3995		$com = qq(<span style="color:red">) . join('??,@dir_user) . qq(????W???????/span>);
3996		} else {
3997		$com = qq(<span style="color:red"><a href="$script?mode=admin&mode2=user&login_admin=$login_admin&$tm{"$_"}=) . &url_encode('???W') . qq(#input">) . $dir_user[0] . qq(????W???????/a></span>);
3998		}
3999		} else {
4000		$com = " ";
4001		}
4002		$htacc_table .= qq(<tr><td><span style="color:red">${htac_file}????????/span></td><td colspan="2">$com</td></tr>\n) if (param('show_htaccess'));
4003		}
4004		}
4005		$htacc_table .= qq(</table>\n) if param('show_htaccess') && @updir_list;
4006		if (! $use_htaccess && @del_list) {
4007		if (param('del_htaccess')) {
4008		foreach (@del_list) {
4009		if (unlink $_) {
4010		$comment{'htac'} .= qq(<div style="color:red"><strong>$_</strong>?????????/div>);
4011		} else {
4012		$comment{'htac'} .= qq(<div style="color:red"><strong>$_</strong>?????????????/div>);
4013		}
4014		}
4015		} else {
4016		$comment{'htac'} .= qq(.htaccess??g?p?????????br />\n<div style="color:blue">\n);
4017		foreach (@del_list) {
4018		$comment{'htac'} .= $_ . "<br />";
4019		}
4020		$comment{'htac'} .= qq(</div>\n???????B????????H<br />\n);
4021		$comment{'htac'} .= qq(<a href="$script?mode=admin&mode2=user&id=) . &url_encode($id) . qq(&login_admin=$login_admin&del_htaccess=1">??????/a>);
4022		}
4023		}
4024		$html .= qq(<div style="padding:0.5em"><a name="anchor" id="anchor">$comment{'htac'}</a></div>) if $comment{'htac'};
4025		$html = '' if ! scalar(@user);
4026		$html = $usr_form . $html;
4027		$html .= $htacc_table if $use_htaccess && scalar(@user);
4028		return $html;
4029		}
4030
4031
4032		sub show_acc_log {
4033		my $html;
4034		$html .= qq(<table border="1" cellpadding="4" cellspacing="0" summary="?A?N?Z?X???O" style="margin:4px 0 4px 0"><tr><th colspan="3"><a name="acc_log" id="acc_log">?A?N?Z?X???O</a></th></tr>\n);
4035		$html .= qq(<tr><th>???[?U?[??/th><th>?A?N?Z?X???/th><th>?z?X?g</th></tr>\n);
4036		my @access = &read_file($access);
4037		my $count = 0;
4038		foreach(@access){
4039		my ($ac_user, $ac_time, $ac_host, $tm) = split(/\,/);
4040		$ac_user = &rechange($ac_user);
4041		my $ac_time_o = $ac_time;
4042		$ac_time =~ s/(\(??))/<span style="color:red">$1<\/span>/;
4043		$ac_time =~ s/($?y$)/<span style="color:blue">$1<\/span>/;
4044		if ($ac_user =~ /$?????Q?X?g$$/) {
4045		$tm .= 'g';
4046		} elsif ($ac_user =~ /$?Q?X?g$$/) {
4047		$tm .= 't';
4048		}
4049		if (! $tm) {
4050		$tm .= 'a';
4051		}
4052		my $log_link;
4053		my $pass = param('pass');
4054		my $sort = param('sort');
4055		my $mode2 = param('mode2');
4056		my %param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>$mode2,'line'=>$count);
4057		if (param('show_log') && param('line') == $count) {
4058		$log_link = qq($script?mode=admin&login_admin=) . param('login_admin') . qq(&sort=) . param('sort') . qq(&mode2=) . param('mode2') . qq(&line=$count#line$count);
4059		} else {
4060		$log_link = qq($script?mode=admin&login_admin=) . param('login_admin') . qq(&sort=) . param('sort') . qq(&mode2=) . param('mode2') . qq(&show_log=$tm&line=$count#line$count);
4061		$param{'show_log'} = $tm;
4062		}
4063		my ($html2, $rowspan);
4064		if (param('show_log') && param('line') == $count && open(LOG,join('/',$access_dir,param('show_log') . '.cgi'))) {
4065		my @log = <LOG>;
4066		close(LOG);
4067		@log =reverse @log;
4068		$rowspan = scalar(@log);
4069		my $sub = 0;
4070		foreach (@log) {
4071		my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
4072		$name = &rechange($name);
4073		$ax_tm =~ s/(\(??))/<span style="color:red">$1<\/span>/;
4074		$ax_tm =~ s/($?y$)/<span style="color:blue">$1<\/span>/;
4075		if (! $sub) {
4076		$html2 .= qq(<tr><td rowspan="$rowspan" style="text-align:right;vertical-align:top;">$name</td><td><small>$ax_tm</small></td><td><small>$host</small></td></tr>\n);
4077		} else {
4078		$html2 .= qq(<tr><td><small>$ax_tm</small></td><td><small>$host</small></td></tr>\n);
4079		}
4080		$sub++;
4081		}
4082		}
4083		$html .= qq(<tr><td><a name="line$count" id="line$count">$ac_user</a></td>);
4084		if ($post_only) {
4085		$html .= qq(<td><form action="$script#line$count" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$ac_time_o" style="font-size:80%" /></form></td>\n);
4086		} else {
4087		$html .= qq(<td><small><a href="$log_link" style="padding:0.2em">$ac_time</a></small></td>\n);
4088		}
4089		$html .= qq(<td><small>$ac_host</small></td></tr>\n);
4090		$html .= $html2;
4091		$count++;
4092		}
4093		$html .= qq(</table>\n);
4094		}
4095
4096
4097		sub show_del_file {
4098		my @del_file_list = &read_file('./delete.log');
4099		my $html;
4100		$html .= qq(<table border="1" cellspacing="0" summary="??????????t?@?C??">\n);
4101		$html .= qq(<caption>??????????t?@?C??</caption>);
4102		$html .= qq(<tr><th>????????</th><th>?f?B???N?g??</th><th>?t?@?C????/th></tr>\n);
4103		@del_file_list = reverse @del_file_list;
4104		foreach (@del_file_list) {
4105		my ($tm,$path) = split(/<>/);
4106		$path =~ s/([^\/]*)$//;
4107		my $file = &url_decode($1);
4108		chomp $file;
4109		my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($tm);
4110		my @youbi = ("??, "??, "??, "??", "??, "??, "?y");
4111		$wday = $youbi[$wday];
4112		$year += 1900;
4113		$month++;
4114		my($time) = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
4115		if ($file =~ /_count$/) {
4116		$html .= qq(<tr style="color:#999999"><td><span style="font-size:80%">) . $time . "</span></td><td>" . $path . "</td><td>$file</td></tr>\n";
4117		} else {
4118		$html .= qq(<tr><td><span style="font-size:80%">) . $time . "</span></td><td>" . $path . "</td><td>$file</td></tr>\n";
4119		}
4120		}
4121		$html .= qq(</table>\n);
4122		return $html
4123		}
4124
4125
4126		sub file_manage {
4127		if (param('show_del_file')) {
4128		my $html = &show_del_file;
4129		return $html;
4130		}
4131		@up_file_list = ();
4132		my $html;
4133		&file_list($root);
4134		my (@d, $d);
4135		foreach (@up_file_list) {
4136		/([^\/]*)$/;
4137		if (! param('show_all')) {
4138		next if $1 eq 'index.html' \|\| $1 eq '.htaccess' \|\| $1 =~ /_count$/;
4139		}
4140		@d = $_ =~ /\//g;
4141		$d = scalar(@d) if $d < scalar(@d);
4142		}
4143		my %comment;
4144
4145		# ?t?@?C????u??????v?{?^????????? if (param('del_old') \|\| param('file_delete')) {
4146		my $del_day = param('del_day');
4147		$del_day = $life if ! $del_day;
4148		foreach (@up_file_list) {
4149		if (param("$_")) {
4150		if (unlink $_) {
4151		push(@del_list,$_);
4152		if (-e $_ . '_count') {
4153		unlink($_ . '_count');
4154		}
4155		}
4156		}
4157		}
4158		&delete_old($updir,$del_day);
4159		if (@del_list) {
4160		$comment{'del_file'} .= qq(<span style="color:red">);
4161		foreach (@del_list) {
4162		$comment{'del_file'} .= qq(<strong>) . &url_decode($_) . qq(</strong>?????????B<br />\n);
4163		}
4164		$comment{'del_file'} .= qq(</span>\n);
4165		if ($delete_log ) { &delete_log(@del_list); }
4166		} else {
4167		$comment{'del_file'} .= qq(<span style="color:red">??????t?@?C??????????B</span>);
4168		}
4169		@up_file_list = ();
4170		&file_list($root);
4171		}
4172		$html .= $comment{'del_file'} if $comment{'del_file'};
4173		$html .= qq(<table summary="???????t?H?[??">\n);
4174		$html .= qq(<tr><td colspan="2">);
4175		$html .= qq(<form action="$script" method="post" style="margin:0;padding:0">\n<input type="hidden" name="mode" value="admin" />\n<input type="hidden" name="mode2" value="file_manage" />\n);
4176		$html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
4177		$html .= qq(?A?b?v???[?h???input type="text" name="del_day" value="${life}" size="2" style="ime-mode:disabled" />);
4178		$html .= qq(????o????t?@?C????input type="submit" name="del_old" value="?????? style="margin:0" />);
4179		$html .= qq(</form>\n);
4180		$html .= qq(</td>);
4181		if (-e './delete.log') {
4182		my %param = ('mode'=>'admin','mode2'=>'file_manage','show_del_file'=>'1','login_admin'=>$login_admin);
4183		if ($post_only) {
4184		$html .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="??????????t?@?C??" /></form></td>);
4185		} else {
4186		$html .= qq(<td>  <a href="$script) . &url_param(%param) . qq(">??????????t?@?C??</a></td>);
4187		}
4188		}
4189		$html .= qq(</tr>\n</table>\n);
4190		my $form2;
4191		my $show_all = param('show_all');
4192		my %param = ('mode'=>'admin','mode2'=>'file_manage','login_admin'=>$login_admin,'show_all'=>$show_all);
4193		my $reload;
4194		if ($post_only) {
4195		$reload = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/reload.gif" alt="?????[?h" /><input type="submit" value="?????[?h" /></form>);
4196		} else {
4197		$reload = qq( <a href="$script) . &url_param(%param) . qq(">?????[?h</a>);
4198		}
4199		undef $show_all;
4200		if (param('show_all')) {
4201		$param{'show_all'} = 0;
4202		if ($post_only) {
4203		$show_all = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?B??t?@?C????B?? /></form>);
4204		} else {
4205		$show_all = qq( <a href="$script) . &url_param(%param) . qq(">?B??t?@?C????B??/a>);
4206		}
4207		} else {
4208		$param{'show_all'} = 1;
4209		if ($post_only) {
4210		$show_all = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="?B??t?@?C????\\??" /></form>);
4211		} else {
4212		$show_all = qq( <a href="$script) . &url_param(%param) . qq(">?B??t?@?C????\\??</a>);
4213		}
4214		}
4215		$form2 .= qq(<table summary="?t?@?C????????j???["><tr><td>?t?@?C?????</td><td>$reload</td><td>$show_all</td></tr></table>\n);
4216		$form2 .= qq(<table summary="??????t?H?[??" border="1" cellpadding="1" cellspacing="0">\n);
4217		my ($tree, @last);
4218		foreach (@up_file_list) {
4219		/([^\/]*)$/;
4220		if (! param('show_all')) {
4221		next if $1 eq 'index.html' \|\| $1 eq '.htaccess' \|\| $1 =~ /_count$/;
4222		}
4223		$tree .= qq(<tr>);
4224		my @path = split(/\//);
4225		for (my $i = 1; $i <= $d; $i++) {
4226		if ($path[$i] ne $last[$i]) {
4227		$last[$i] = $path[$i];
4228		if ($i == scalar(@path) - 1) {
4229		my $colspan = $d - $i + 1;
4230		my $img = &icon($_);
4231		my $file = my $dir = $_;
4232		$file =~ /([^\\\/]+)$/;
4233		$file = $1;
4234		$file =~ s/%/%25/g;
4235		$dir =~ s/\/[^\/]*$//;
4236		$tree .= qq(<td colspan="$colspan" style="text-align:right;">\n);
4237		my %param = ('mode'=>'download','login_admin'=>$login_admin,'dir'=>$dir,'file'=>$file);
4238		if ($post_only) {
4239		$tree .= qq(<table summary="?t?@?C????J??><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/$img" alt=") . &url_decode($path[$i]) . qq(??J?? /></form></td><td>) . &url_decode($path[$i]) . qq(</td></tr></table>\n);
4240		} else {
4241		$tree .= qq(<a href="$script) . &url_param(%param) . qq(" title="$_"><span style="position:relative;top:4px;right:1px"><img src="./img/$img" style="border:0" alt="$img" /></span>) . &url_decode($path[$i]) . qq(</a>);
4242		}
4243		$tree .= qq(</td>\n);
4244		last;
4245		} else {
4246		my $dir = $_;
4247		for (my $j=$i; $j < (scalar(@path) - 1); $j++) {
4248		$dir =~ s/\/[^\/]*$//;
4249		}
4250		my %param = ('login_admin'=>$login_admin,'dir'=>$dir);
4251		if ($post_only) {
4252		$tree .= qq(<td><table summary="?f?B???N?g??????><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/dir.gif" alt="$path[$i]?f?B???N?g?????? /></form></td><td>$path[$i]</td></tr></table></td>\n);
4253		} else {
4254		$tree .= qq(<td><span style="position:relative;top:4px;right:1px"><img src="./img/dir.gif" alt="dir.gif" /></span><a href="$script) . &url_param(%param) . qq(">$path[$i]</a></td>\n);
4255		}
4256		}
4257		} else {
4258		if ($i == scalar(@path) - 1) {
4259		my $colspan = $d - $i + 1;
4260		my $img = &icon($_);
4261		my $file = $_;
4262		$file =~ s/%/%25/g;
4263		my %param = ('mode'=>'download','login_admin'=>$login_admin,'file'=>$file);
4264		if ($post_only) {
4265		$tree .= qq(<td colspan="$colspan" style="text-align:right;"><table summary="?t?@?C????J??><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/$img" alt=") . &url_decode($path[$i]) . qq(??J?? /></form></td><td>) . &url_decode($path[$i]) . qq(</td></tr></table></td>);
4266		} else {
4267		$tree .= qq(<td colspan="$colspan" style="text-align:right;"><a href="$script) . &url_param(%param) . qq(" title="$_"><span style="position:relative;top:4px;right:1px"><img src="./img/$img" style="border:0" alt="$img" /></span>) . &url_decode($path[$i]) . qq(</a></td>\n);
4268		}
4269		last;
4270		} else {
4271		$tree .= qq(<td> </td>\n);
4272		}
4273		}
4274		}
4275		my $size = (stat($_))[7];
4276		my $mod = (stat($_))[9];
4277		my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($mod);
4278		my @youbi = ("??, "??, "??, "??", "??, "??, "?y");
4279		$wday = $youbi[$wday];
4280		$year += 1900;
4281		$month++;
4282		my($time) = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
4283		my %param = ('mode'=>'admin','mode2'=>'file_manage','login_admin'=>$login_admin,'file_delete'=>'1');
4284		$tree .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" name="$_" value="???" /></form></td>\n);
4285		$tree .= qq(<td style="text-align:right;"><span style="font-size:80%">) . &kiro_byte($size) . qq(</span></td>);
4286		$tree .= qq(<td><span style="font-size:80%"><a title="$_">$time</a></span></td>);
4287		$tree .= qq(</tr>\n);
4288		}
4289		if ($tree) {
4290		$html .= $form2 . $tree . qq(</table>\n);
4291		}
4292		return $html;
4293		}
4294
4295		sub file_list {
4296		my $dir = shift;
4297		my @dir_list;
4298		opendir(DIR,$dir) or return($!);
4299		while (my $file = readdir(DIR)) {
4300		next if $file eq '.' \|\| $file eq '..';
4301		my $path = join('/',$dir,$file);
4302		if (-f $path) {
4303		push(@up_file_list,$path);
4304		} elsif (-d $path) {
4305		push(@dir_list,$path);
4306		}
4307		}
4308		closedir(DIR);
4309		foreach (@dir_list) {
4310		&file_list("$_");
4311		}
4312		}
4313
4314
4315		sub dir_arrange {
4316		@dir_list = ();
4317		my $html;
4318		&get_subdir($root);
4319		my $form;
4320		my $tab_indx = 2;
4321		my $no_user_dir;
4322		foreach my $dir (@dir_list) {
4323		next if $dir eq './upload/usr_root' \|\| $dir eq './upload/root';
4324		my $usr_exs = 0;
4325		my $own;
4326		my @own;
4327		foreach (@user) {
4328		my $usr_dir = (split(/\,/))[2];
4329		if ($dir =~ /^$usr_dir$/ \|\| $dir =~ /^$usr_dir\//) {
4330		$usr_exs = 1;
4331		$own .= (split(/\,/))[1];
4332		push(@own,(split(/\,/))[1]);
4333		}
4334		}
4335		if (! $usr_exs) {
4336		if (param('deldir_' . $dir) eq '???' \|\| param('del_all')) {
4337		if (! &delete_dir($dir)) {
4338		$form .= qq(<tr><td colspan="3"><span style="color:red"><strong>${dir}</strong>?????????/span></td></tr>\n);
4339		}
4340		} else {
4341		if (! -d $dir) {
4342		$form .= qq(<tr><td colspan="3"><span style="color:red">$dir</span></td></tr>\n);
4343		} else {
4344		my %param = ('login_admin'=>$login_admin,'dir'=>$dir);
4345		if ($post_only) {
4346		$form .= qq(<tr><td><table summary="?f?B???N?g??????><tr><td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/dir.gif" alt="${dir}???? /></form></td><td>$dir</td></tr></table></td>\n);
4347		} else {
4348		$form .= qq(<tr><td><a href="$script) . &url_param(%param) . qq(" title="${dir}????>$dir</a> </td>\n);
4349		}
4350		undef %param;
4351		%param = ('del_dir'=>'1','mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'dir_arrange');
4352		$form .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" name="deldir_$dir" value="???" tabindex="$tab_indx" /></form></td>\n);
4353		$file_nmb = 0;
4354		$dir_nmb = 0;
4355		my $size = &kiro_byte(&size_measure($dir));
4356		$form .= qq(<td><span style="font-size:80%">$$size$ ?t?@?C??$file_nmb??nbsp;?f?B???N?g??$dir_nmb??/span></td></tr>\n); $tab_indx++;
4357		$no_user_dir = 1;
4358		}
4359		}
4360		}
4361		}
4362		if ($no_user_dir) {
4363		$html .= qq(<div>????f?B???N?g????A?N?Z?X??????[?U?[??????B????????H</div>\n);
4364		} else {
4365		$html .= qq(<div>??p???????f?B???N?g??????????/div>\n);
4366		}
4367		my %param = ('del_dir'=>1,'mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'dir_arrange');
4368		$html .= qq(<form action="$script" method="post">\n);
4369		$html .= &hidden_param(%param);
4370		$html .= qq(<input type="submit" name="del_all" value="?S????" tabindex="$tab_indx" /> );
4371		$html .= qq(<input type="submit" value="?????[?h" tabindex="1" />\n);
4372		$html .= qq(</form>\n);
4373		if ($form) {
4374		$html .= qq(<table border="1" cellspacing="0" summary="?f?B???N?g??????t?H?[??">\n);
4375		$html .= $form;
4376		$html .= qq(</table>\n);
4377		}
4378		return $html;
4379		}
4380
4381
4382		sub read_file {
4383		my @log;
4384		my $file_path = $_[0];
4385		if (open(IN,"$file_path")) {
4386		@log = <IN>;
4387		close(IN);
4388		}
4389		return @log;
4390		}
4391
4392
4393		sub user {
4394		if (param('cancel')) {
4395		my $jump = $script . qq(?login_user=$login_user);
4396		&redirect($jump);
4397		exit;
4398		}
4399		if (param('do_del')) {
4400		my @new_user = ();
4401		my ($del_dir, $enc_pass);
4402		&lock();
4403		my @user = &read_file('./user.cgi');
4404		foreach (@user) {
4405		my ($time,$name,$dir,$epass) = split(/\,/);
4406		if ($tm{"$id"} != $time \|\| $id ne $name) {
4407		push(@new_user,$_);
4408		} else {
4409		$del_dir = $dir;
4410		$enc_pass = $epass;
4411		}
4412		}
4413		if (param('del_dir')) {
4414		&delete_dir($del_dir);
4415		my $pass_file_dir = join('/', $passdir, 'upload/usr_root', $enc_pass);
4416		&delete_dir($pass_file_dir);
4417		}
4418		if (open(USR,">./user.cgi")) {
4419		print USR @new_user;
4420		close(USR);
4421		}
4422
4423		# ??p?X???h????????? my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
4424		open(RAW,"$raw_pass_path");
4425		my @raw_pass_list = <RAW>;
4426		close(RAW);
4427		open(RAW,">$raw_pass_path");
4428		foreach (@raw_pass_list) {
4429		if ((split(/,/))[0] != $tm{"$id"}) {
4430		print RAW $_;
4431		}
4432		}
4433		close(RAW);
4434		&unlock();
4435		&set_cookie(); # ???????N?b?L?[??????? if ($mail_notify && @admin_mail) {
4436		my ($mail_title, @msg, $msg);
4437		$mail_title = '?y' . $simple_title . '?z' . $id . "${mr}?o?^???;
4438		my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
4439		$year+=1900;
4440		$mon++;
4441		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
4442		@msg = &read_file('./mail_template/u2a_del.txt');
4443		$msg = join('',@msg);
4444		my $url = url;
4445		$msg =~ s/<date>/$tm_com/g;
4446		$msg =~ s/<title>/$simple_title/g;
4447		$msg =~ s/<user>/$id/g;
4448		$msg =~ s/<mr>/$mr/g;
4449		$msg =~ s/<url>/$url/g;
4450		foreach (@admin_mail) {
4451		&notify($mail_title, $msg, $_);
4452		}
4453		}
4454		my $jump = qq($script?message=) . &url_encode(qq(<strong>${id}</strong>??o?^?????????B));
4455		&redirect($jump);
4456		exit;
4457		}
4458		$title .= qq(???[?U?[?????;
4459		if (param('chg_do')) {
4460		if ($use_htaccess && param('new_id') =~ /:/) {
4461		&error('???[?U?[??G???[','???[?U?[???(?R????)??g?????????B');
4462		}
4463		if (length(param('new_id')) > $max_user_id) {
4464		&error('???[?U?[??G???[',"???[?U?[????p??{max_user_id}????A?S?p?? . (int($max_user_id / 2)) . '?????????????B');
4465		}
4466		if (param('new_pass') && length(param('new_pass')) < $pass_length) { &error('?G???[',"?p?X???h??{pass_length}?????????????); }
4467		if ($chk_mail) {
4468		require './email_chk.pl';
4469		if (param('new_mail') && ! &email_chk(param('new_mail'))) { &error('?G???[',"???[???A?h???X????????????????B"); }
4470		}
4471		my @new_user = ();
4472		my ($comment, $tmp_id, $tmp_pass);
4473		&lock();
4474		my @user = &read_file('./user.cgi');
4475		foreach (@user) {
4476		my ($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail) = split(/\,/);
4477		if ($tm{"$id"} != $time) {
4478		push(@new_user,$_);
4479		} else {
4480		if (param('new_id') ne param('old_id')) {
4481		$name = param('new_id');
4482		$comment .= qq(???[?U?[???strong>) . param('new_id') . qq(</strong>???X?????B) . "<br />";
4483		$tmp_id = param('new_id');
4484		my $tmp_dir = $dir;
4485		$tmp_dir =~ s/^\.\///;
4486		my $pass_file_path = join('/', $passdir, $tmp_dir, '.htpasswd'); # ?p?X???h?t?@?C????p?X
4487		if (open(PAS,"$pass_file_path")) {
4488		my @pass_list = <PAS>;
4489		close(PAS);
4490		my @new_pass_list = ();
4491		foreach (@pass_list) {
4492		my ($name,$pass) = split(/:/);
4493		if ($name eq param('old_id')) {
4494		push(@new_pass_list, param('new_id') . qq(:$epass\n));
4495		} else {
4496		push(@new_pass_list,$_);
4497		}
4498		}
4499		open(PAS,">$pass_file_path");
4500		print PAS @new_pass_list;
4501		close(PAS);
4502		}
4503		open(LGI,">" . join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_user . '.cgi'));
4504		print LGI $tmp_id;
4505		close(LGI);
4506		}
4507		my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
4508		my (@raw_pass_list, @new_raw_pass_list, $pass_e);
4509		if (open(RAW,"$raw_pass_path")) {
4510		@raw_pass_list = <RAW>;
4511		close(RAW);
4512		}
4513		my $rewrite = 1; # ??p?X???h?????????????A??????B?t?@?C????_?E?????[?h????????????????B
4514		foreach (@raw_pass_list) {
4515		my ($tm,$raw_pass) = split(/,/);
4516		chomp $raw_pass;
4517		if ($tm == $tm{"$id"}) {
4518		if ($raw_pass) {
4519		$rewrite = 0;
4520		}
4521		}
4522		}
4523		# $rewrite??rue???????p?X???h??????????X(ver.1.8)
4524		if (param('new_pass') ne param('old_pass') \|\| $rewrite) {
4525		my $new_raw_pass = param('new_pass');
4526		$epass = &encrypt($new_raw_pass);
4527		foreach (@raw_pass_list) {
4528		my ($tm,$raw_pass) = split(/,/);
4529		if ($tm == $tm{"$id"}) {
4530		my $e_new_raw_pass = &change($new_raw_pass);
4531		push(@new_raw_pass_list,qq($tm,$e_new_raw_pass,\n));
4532		$pass_e = 1;
4533		} else {
4534		push(@new_raw_pass_list,$_);
4535		}
4536		}
4537		if (! $pass_e) {
4538		my $e_new_raw_pass = &change($new_raw_pass);
4539		push(@new_raw_pass_list,qq($tm{"$id"},$e_new_raw_pass,\n));
4540		}
4541		open(RAW,">$raw_pass_path");
4542		print RAW @new_raw_pass_list;
4543		close(RAW);
4544		my $tmp_dir = $dir;
4545		$tmp_dir =~ s/^\.\///;
4546		my $pass_file_path = join('/', $passdir, $tmp_dir, '.htpasswd'); # ?p?X???h?t?@?C????p?X
4547		if (open(PAS,"$pass_file_path")) {
4548		my @pass_list = <PAS>;
4549		close(PAS);
4550		my @new_pass_list = ();
4551		foreach (@pass_list) {
4552		my ($name,$pass) = split(/:/);
4553		if ($name eq param('old_id')) {
4554		push(@new_pass_list, param('new_id') . qq(:$epass\n));
4555		} else {
4556		push(@new_pass_list,$_);
4557		}
4558		}
4559		open(PAS,">$pass_file_path");
4560		print PAS @new_pass_list;
4561		close(PAS);
4562		}
4563		$comment .= qq(?p?X???h??strong>) . param('new_pass') . qq(</strong>???X?????B) . "<br />";
4564		$tmp_pass = param('new_pass');
4565		}
4566		if (param('new_mail') ne param('old_mail')) {
4567		$email = param('new_mail');
4568		$comment .= qq(???[???A?h???X??strong>) . param('new_mail') . qq(</strong>???X?????B) . "<br />";
4569		}
4570		$dlmail = param('dlmail');
4571		if (param('max_day') != $max_day{"$id"}) {
4572		$comment .= qq(?t?@?C?????????strong>) . param('max_day') . qq(??/strong>???X?????B) . "<br />";
4573		}
4574		if (param('max_down') != $max_down{"$id"}) {
4575		$comment .= qq(?_?E?????[?h??????strong>) . param('max_down') . qq(??/strong>???X?????B) . "<br />";
4576		}
4577		if (param('dlmail') != $dlmail{"$id"}) {
4578		if (param('dlmail')) {
4579		$comment .= qq(?Q?X?g??t?@?C????_?E?????[?h??????[????m????????????B) . "<br />";
4580		} else {
4581		$comment .= qq(?Q?X?g??t?@?C????_?E?????[?h???????[????m???????????B) . "<br />";
4582		}
4583		}
4584		$name = &change($name);
4585		$max_day = param('max_day') if param('max_day');
4586		$max_down = param('max_down') if param('max_down');
4587		push(@new_user,qq($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail,\n));
4588		}
4589		}
4590		if (open(USR,">./user.cgi")) {
4591		print USR @new_user;
4592		close(USR);
4593		}
4594		&unlock();
4595		if ($mail_notify && @admin_mail) {
4596		my ($mail_title, @msg, $msg);
4597		$mail_title = '?y' . $simple_title . '?z' . $id . "${mr}?o?^??X";
4598		my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
4599		$year+=1900;
4600		$mon++;
4601		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
4602		@msg = &read_file('./mail_template/u2a_mod.txt');
4603		$msg = join('',@msg);
4604		my $url = url;
4605		my $change = '';
4606		if (param('new_id') ne param('old_id')) {
4607		$change .= qq(???[?U?[??: ) . param('old_id') . qq( ??) . param('new_id') . qq(\n);
4608		}
4609		if (param('new_pass') ne param('old_pass')) {
4610		# $change .= qq(?p?X???h : ) . param('old_pass') . qq( ??) . param('new_pass') . qq(\n);
4611		$change .= qq(?p?X???h : ) . "****" . qq( ??) . "****" . qq(\n); # ?p?X???h??\?????? }
4612		if (param('new_mail') ne param('old_mail')) {
4613		$change .= qq(???[???A?h???X : ) . param('old_mail') . qq( ??) . param('new_mail') . qq(\n);
4614		}
4615		$msg =~ s/<date>/$tm_com/g;
4616		$msg =~ s/<title>/$simple_title/g;
4617		$msg =~ s/<user>/$id/g;
4618		$msg =~ s/<mr>/$mr/g;
4619		$msg =~ s/<url>/$url/g;
4620		$msg =~ s/<change>/$change/g;
4621		# ??X?????????????[?????M
4622		if ($change) {
4623		foreach (@admin_mail) {
4624		&notify($mail_title, $msg, $_);
4625		}
4626		}
4627		}
4628		$id = $tmp_id if $tmp_id;
4629		$pass = $tmp_pass if $tmp_pass;
4630		&set_cookie($id,$pass,param('save_cook'));
4631		$comment = qq(????X????????B<br />) if ! $comment;
4632		my $jump = qq($script?mode=user&id=) . &url_encode($id) . qq(&login_user=$login_user&comment=) . &url_encode($comment);
4633		&redirect($jump);
4634		}
4635		&header;
4636		if (param('del_regist')) {
4637		my %param = ('login_user'=>$login_user,'mode'=>'user');
4638		my $hidden = &hidden_param(%param);
4639		print <<"EOM";
4640		<div style="text-align:center;">
4641		<strong>$id</strong>??o?^?????????<form action="$script" method="post">
4642		$hidden
4643		<input type="submit" name="do_del" value="?????? tabindex="1" />
4644		<input type="submit" name="cancel" value="?L?????Z??" tabindex="2" />
4645		<br /><input type="checkbox" name="del_dir" id="del_dir" checked="checked" value="1" tabindex="3" /> <label for="del_dir">??p?f?B???N?g?????????/label>
4646		</form>
4647		</div>
4648		EOM
4649		&footer;
4650		return;
4651		}
4652		my ($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail);
4653		foreach (@user) {
4654		($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail) = split(/\,/);
4655		if ($tm{"$id"} == $time) {
4656		last;
4657		}
4658		}
4659		chomp $dlmail;
4660		my ($cid,$cpass,$cuse_cook) = &get_cookie;
4661		my ($chk, $dlm_chk);
4662		if ($cuse_cook) {
4663		$chk = qq( checked="checked");
4664		} else {
4665		$chk = '';
4666		}
4667		if ($dlmail) {
4668		$dlm_chk = qq( checked="checked");
4669		} else {
4670		$dlm_chk = '';
4671		}
4672		my ($auto_pass,$auto_pass_com,$hidden) = &auto_pass_frm(6);
4673		my $pass = param('pass');
4674		my $old_id = $id;
4675		my $old_pass = my $new_pass = $pass;
4676		$new_pass = $auto_pass if $auto_pass;
4677		my $old_mail = $mail{"$id"};
4678		my $comment = qq(<span style="color:red">) . param('comment') . qq(</span>) if param('comment');
4679		my $cancel_button = '?L?????Z??';
4680		$cancel_button = '??? if $comment;
4681		my $max_day_op = qq(<select name="max_day">\n);
4682		for(my $count=$auto_delete;$count>=1;$count--) {
4683		chomp $max_day{"$id"};
4684		$max_day{"$id"} = 0 if ! $max_day{"$id"};
4685		if ($max_day{"$id"} == $count \|\| (!$max_day{"$id"} && $count == $auto_delete)) {
4686		$max_day_op .= qq(<option value="$count" selected="selected">${count}??/option>\n);
4687		} else {
4688		$max_day_op .= qq(<option value="$count">${count}??/option>\n);
4689		}
4690		}
4691		$max_day_op .= qq(</select>\n);
4692		my $max_down_op = qq(<select name="max_down">);
4693		for(my $count=$max_dl_count;$count>=1;$count--) {
4694		if ($max_down{"$id"} == $count \|\| (!$max_down{"$id"} && $count == $max_dl_count)) {
4695		$max_down_op .= qq(<option value="$count" selected="selected">${count}??/option>\n);
4696		} else {
4697		$max_down_op .= qq(<option value="$count">${count}??/option>\n);
4698		}
4699		}
4700		$max_down_op .= qq(</select>\n);
4701		my $dlmail_form;
4702		if ($send_dlmail && $email) {
4703		$dlmail_form = qq(<tr><td style="text-align:right;"><input type="checkbox"$dlm_chk name="dlmail" id="dlmail" value="1" tabindex="9" /></td><td align="left"><label for="dlmail">?t?@?C????_?E?????[?h???????[????m????/label></td></tr>);
4704		}
4705		my $width1 = 120;
4706		if (length($id) > 20) {
4707		$width1 = length($id) * 6;
4708		}
4709		my %param = ('mode'=>'user','login_user'=>$login_user,'old_id'=>$id,'old_pass'=>$pass,'old_mail'=>$mail{"$id"});
4710		$hidden = &hidden_param(%param) . $hidden;
4711		print <<"EOF";
4712		<div style="text-align:center;margin:1em">
4713		$comment
4714		??X????????C????u??X?v?{?^????????????nbsp; <a href="userconfig_help.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="?w???v" />?w???v</a>
4715		<form action="$script" method="post">
4716		$hidden
4717		<table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="?V?K?o?^?t?H?[??">
4718		<tr><td colspan="2" style="text-align:center;"><input type="submit" name="chg_do" value="??@?X" tabindex="1" />  <input type="reset" tabindex="2" />  <input type="submit" name="cancel" value="$cancel_button" tabindex="3" /></td></tr>
4719		<tr><td style="text-align:right;">???[?U?[??span style="color:red;font-size:80%">??K?{</span></td><td align="left"><input type="text" name="new_id" value="$id" style="width:${width1}px;height:16px" tabindex="4" /></td></tr>
4720		<tr><td style="text-align:right;">?p?X???h<span style="color:red;font-size:80%">??K?{</span></td><td align="left"><input type="text" name="new_pass" value="$new_pass" style="width:120px;height:16px" tabindex="5" />
4721		<span style="color:red;font-size:80%">??X????????L????????/span></td></tr>
4722		$auto_pass_com
4723		<tr><td colspan="2" style="text-align:right;"><span style="font-size:80%">??p?X???h??/span> <span style="font-weight:bold;font-size:120%">$ban</span> <span style="font-size:80%">??g?p?????????/span></td></tr>
4724		<tr><td style="text-align:right;">???[???A?h???X</td><td align="left"><input type="text" name="new_mail" value="$mail{"$id"}" style="ime-mode:disabled; width:120px;height:16px" tabindex="7" /></td></tr>
4725		<tr><td style="text-align:right;"><input type="checkbox"$chk name="save_cook" id="save_cook" value="1" tabindex="8" /></td><td align="left"><label for="save_cook">?N?b?L?[??g?p???/label></td></tr>
4726		$dlmail_form
4727		<tr><td style="text-align:right;">?t?@?C???????</td><td style="text-align:left;">$max_day_op<span style="font-size:80%">(?Q?X?g??L????f?t?H???g)</span></td></tr>
4728		<tr><td style="text-align:right;">?_?E?????[?h?????/td><td style="text-align:left;">$max_down_op<span style="font-size:80%">(????????t?@?C??????)</span></td></tr>
4729		</table>
4730		<table style="margin:auto;margin-top:2em">
4731		<tr><td colspan="2" style="text-align:center;"><input type="submit" name="del_regist" value="?o?^??????? style="margin:4px" tabindex="9" /></td></tr>
4732		</table>
4733		</form>
4734		</div>
4735		EOF
4736		&footer;
4737		}
4738
4739
4740		sub redirect {
4741		if ($ENV{PERLXS} eq "PerlIS") {
4742		print "HTTP/1.0 302 Temporary Redirection\r\n";
4743		print "Content-type: text/html\n";
4744		}
4745		print "Location: $_[0]" ."\n\n";
4746		exit;
4747		}
4748
4749
4750		sub jump {
4751		my $param = $_[0];
4752		my %param = %$param;
4753		if ($header_flag) { return; }
4754		my $nohead = $_[0];
4755		$header_flag = 1;
4756		print "Content-type: text/html\n\n";
4757		print <<"EOM";
4758		<?xml version="1.0" encoding="Shift_JIS"?>
4759		<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
4760		<html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja">
4761		<head>
4762		<meta http-equiv="content-type" content="text/html; charset=Shift_JIS" />
4763		<meta http-equiv="content-style-type" content="text/css" />
4764		<meta http-equiv="content-script-type" content="text/javascript" />
4765		<meta name="description" content="?}???`?A?b?v???[?_" />
4766		<meta name="keywords" content="?L?[???h????? />
4767		<title>$title</title>
4768		<link rel="shortcut icon" href="./favicon.ico" />
4769		<link rel="stylesheet" href="./style.css" type="text/css" />
4770		</head>
4771		<body onLoad="document.f.submit()";>
4772		EOM
4773		print &headline;
4774		print qq(<form action="$script" name=f method="post">\n);
4775		foreach (keys %param) {
4776		print qq(<input type="hidden" name="$_" value=") . &url_decode($param{$_}) . qq(" />\n);
4777		}
4778		print qq(</form>\n);
4779		print qq(</body></html>);
4780		}
4781
4782		sub config {
4783		my $do_word = shift;
4784		my $tindx = shift;
4785		if (! open(SCR,"$script")) {
4786		return;
4787		}
4788		my @scr = <SCR>;
4789		close(SCR);
4790		my ($comment, $chg_use_htaccess, $chg_passdir);
4791		if (&url_decode(param('config')) eq $do_word) {
4792		my @new_scr = ();
4793		my @config_value = ();
4794		push(@config_value,qq(adminpass<>$adminpass\n));
4795		push(@config_value,qq(passdir<>$passdir\n));
4796		my ($chg_com,$config_start,$config_end);
4797		foreach my $line (@scr) {
4798		if ($line =~ /^# config_start/) { $config_start = 1; }
4799		if ($line =~ /^# config_end/) { $config_end = 1; }
4800		if ($config_end \|\| ! $config_start) {
4801		push(@new_scr, $line);
4802		next;
4803		}
4804		foreach my $cfg (@config) {
4805		if ($cfg && $line =~ /^\s(my)?\s\$$cfg\s=\s/) {
4806		my ($value,$val);
4807		if (param("$cfg") =~ /^\d+$/) {
4808		$value = param("$cfg");
4809		} else {
4810		$val = param("$cfg");
4811		$val =~ s/</</g;
4812		$val =~ s/>/>/g;
4813		$val =~ s/"/"/g;
4814		$val =~ s/\\$//;
4815		$value = "'" . $val . "'";
4816		}
4817		if ($cfg eq 'use_htaccess' && param("$cfg")) {
4818		$chg_use_htaccess = 1;
4819		}
4820		my list($frm,$com) = explode(';',$line);
4821		mylist($var,$oval) = explode('=',$frm);
4822		my @oval = split(/=/,$frm);
4823		shift @oval;
4824		$oval = join('=',@oval);
4825		$oval =~ s/\s//;
4826		$oval =~ s/^['"]//;
4827		$oval =~ s/['"]$//;
4828		if ($oval ne param("$cfg")) {
4829		$chg_com .= qq(<div style="color:red">${frm} ??nbsp;) . 'my $' . $cfg . " = " . $value . qq(</div>\n);
4830		}
4831		chomp $com;
4832		$line = 'my $' . $cfg . " = " . $value . ";" . $com . "\n";
4833		push(@config_value,qq($cfg<>) . param("$cfg") . qq(\n));
4834		last;
4835		}
4836		}
4837		if ($chg_use_htaccess && ! $passdir && $line =~ /^\smy\s\$passdir\s=\s/) {
4838		my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
4839		srand;
4840		for (1 .. 12) {
4841		$passdir .= $salt[int(rand(@salt))];
4842		}
4843		my $value = qq('$passdir');
4844		my @tmp = split(/;/,$line);
4845		my $com = pop(@tmp);
4846		chomp $com;
4847		$line = 'my $passdir = ' . $value . ";" . $com . "\n";
4848		if (! -d $passdir) {
4849		mkdir $passdir;
4850		}
4851		my $index = join('/',$passdir,'index.html');
4852		if ($make_index && ! -f $index) {
4853		open(INDX,">$index");
4854		close(INDX);
4855		}
4856		}
4857		push(@new_scr, $line);
4858		}
4859
4860		# ?????O??o?b?N?A?b?v??? open(INIT,">${script}_bck.cgi") \|\| &error('?o?b?N?A?b?v?G???[',"${script}_bck.cgi??J?????B");
4861		print INIT @scr;
4862		close(INIT);
4863
4864		open(NEW,">$script") \|\| &error('?G???[',"${script}??J?????B");
4865		print NEW @new_scr;
4866		close(NEW);
4867
4868		# ???????? open(CFG,">$config_file") \|\| &error('?G???[',"${config_file}??J?????B");
4869		print CFG @config_value;
4870		close(CFG);
4871
4872		@scr = @new_scr;
4873		$comment = qq(<div style="color:blue"><a name="anchor" id="anchor" style="padding:0.5em">?X?N???v?g??????W?????B</a></div>);
4874		$comment .= $chg_com;
4875		}
4876		my $anchor;
4877		if (param('config') ne $do_word) {
4878		$anchor = qq(<a name="anchor" id="anchor"> </a>);
4879		}
4880		my $html;
4881		$html .= qq(<strong>???GI???u?f?B???N?g??</strong>?F$path<br />\n);
4882		$html .= $comment if $comment;
4883		$html .= qq(<form action="${script}#anchor" method="post" style="margin:0">\n);
4884		$html .= qq(<input type="hidden" name="mode" value="$mode" />\n);
4885		$html .= qq(<input type="hidden" name="mode2" value="config" />\n);
4886		$html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
4887		$html .= qq(<table border="1" cellspacing="0" cellpadding="4" summary="?X?N???v?g?????X?t?H?[??">\n);
4888		$html .= qq(<tr><td colspan="3" align="center"><input type="submit" name="config" value="$do_word" tabindex="$tindx" /></td></tr>\n); $tindx++;
4889		my %config_val;
4890		foreach my $cfg (@config) {
4891		my (@tmp, $com, %popup, $name, $value, $style, $line, $nk_value);
4892		foreach my $line (@scr) {
4893		if ($line =~ /^\s*#/) { next; }
4894		my $tmp = $line;
4895		$tmp =~ s/</</g;
4896		if ($line =~ /\s(my)?\s\$$cfg\s=\s/) {
4897		@tmp = split(/;/,$line);
4898		$com = pop(@tmp);
4899		chomp $com;
4900		$popup{"$cfg"} = $com;
4901		list($name, $value) = explode('=',$tmp[0]);
4902		my @value = split(/=/,$tmp[0]);
4903		shift @value;
4904		$value = join('=',@value);
4905		$name =~ s/^\smy\s[^\$]//;
4906		$name =~ s/\s*$//;
4907		$value =~ s/^\s*['"]?//;
4908		$value =~ s/['"]?\s*$//;
4909		$config_val{"$cfg"} = $value;
4910		last;
4911		}
4912		}
4913		if ($value =~ /#[0-9a-f]{6}/) {
4914		$style = qq( style="background-color:$value;color:) . &text_color($value) . qq(;ime-mode:disabled");
4915		} elsif (($value && $value =~ /^[\d\w%]+$/) \|\| $value eq '0') {
4916		$style = qq( style="ime-mode:disabled");
4917		}
4918		$com = " " if ! $com;
4919		if ($cfg eq 'sendmail' && !-e $value) {
4920		$com = qq(<span style="color:red">${value}????????/span>) . $com;
4921		}
4922		if ($cfg eq 'encode_lib' && $value) {
4923		&module_list($_) for grep {$_ ne '.'} @INC;
4924		if (! $mod_list{'Jcode'}) {
4925		$com = qq(<span style="color:red">Jcode.pm??g????????/span>) . $com;
4926		}
4927		}
4928		if ($cfg eq 'mail_notify' && $value && ! $config_val{"admin_mail"}) {
4929		$com = qq(<span style="color:red">?????????[???A?h???X??o?^????????/span>) . $com;
4930		}
4931		$html .= qq(<tr><td align="right">$line $name = </td><td><input type="text" name="$cfg" value="$value"$style tabindex="$tindx" /></td><td>$com</td></tr>\n); $tindx++;
4932		}
4933		$html .= qq(</table>\n);
4934		$html .= qq(</form>\n);
4935		return $html;
4936		}
4937
4938		sub module_list {
4939		my ($base, $path) = @_;
4940		(my $mod = $path) =~ s!/!::!g;
4941		opendir DIR, "$base/$path" or return;
4942		my @node = grep {!/^\.\.?$/} readdir DIR;
4943		closedir DIR;
4944		foreach (@node) {
4945		if (/(.+)\.pm$/) { $mod_list{"$mod$1"} = 1 }
4946		elsif (-d "$base/$path$_") { module_list($base, "$path$_/") }
4947		}
4948		}
4949
4950		# ?X?V?????\??
4951		sub history {
4952		$title .= ' ?\|?X?V????\|';
4953		&header;
4954		my @history = split("\n",$history);
4955		my $i = 0;
4956		my $j;
4957		foreach (@history) {
4958		if (!/\sver[\.\s]\d/) {
4959		s/#\s*/<br \/>/;
4960		$history[$j] .= $_;
4961		$history[$i] = '';
4962		} else {
4963		$j = $i;
4964		}
4965		$i++;
4966		}
4967		@history = reverse @history;
4968		print qq(<div style="margin:1em 3em 1em 3em;"><a href="#" onclick="history.back(); return false;">???/a>\n<table cellpadding="3" cellspacing="0" style="line-height:1.5em" summary="?X?V????>\n);
4969		my $count;
4970		foreach (@history) {
4971		next if !$_;
4972		s/^#\s*//;
4973		s/\t+/\t/g;
4974		my ($ver,$date,$cont,$cont2,$cont3) = split(/\t/);
4975		if ($count % 2 == 0) {
4976		print qq(<tr>\n);
4977		} else {
4978		print qq(<tr style="background-color:$zebra_back_col">\n);
4979		}
4980		print qq(<td style="vertical-align:top;color:$title_back_col">??/td><td style="vertical-align:top;">$ver</td><td style="vertical-align:top;">$date</td>\n);
4981		$cont .= qq(<br />) . $cont2 if $cont2;
4982		$cont .= qq(<br />) . $cont3 if $cont3;
4983		print qq(<td>$cont</td>\n);
4984		print qq(</tr>\n);
4985		$count++;
4986		}
4987		print qq(</table>\n</div>\n);
4988		&footer;
4989		}
4990
4991
4992		# ?f?B???N?g????????B?e?f?B???N?g????????e?f?B???N?g????????sub make_dir {
4993		my $new_dir = my $par_dir = shift;
4994		if (! mkdir $new_dir) {
4995		$par_dir =~ s/\/[^\/]*$//;
4996		&make_dir($par_dir);
4997		mkdir $new_dir;
4998		} else {
4999		if ($make_index && $new_dir !~ /^$passdir/) {
5000		open(INDEX,">" . join('/',$new_dir,'index.html') );
5001		close(INDEX);
5002		}
5003		}
5004		}
5005
5006		sub make_passdir {
5007		# $passdir???X.htaccess??p?X???h???p?f?B???N?g???????Aver.1.51??~?K?{??????p?X???h???f?B???N?g????????????????A.htaccess??g?p?????????????????X???ver.1.79)?B
5008		# ???o?[?W??????g?p??A$passdir???????????????A?b?v?f?[?g??????A??????I??passdir??????ver.1.8)?B
5009
5010		my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
5011		my $sucs;
5012		for (1 .. 10) {
5013		srand;
5014		for (1 .. 12) {
5015		$passdir .= $salt[int(rand(@salt))];
5016		}
5017		if (mkdir $passdir) {
5018		$sucs = 1;
5019		last;
5020		}
5021		}
5022		if (! $sucs) {
5023		my $message = "?p?X???h???f?B???N?g??????????????B";
5024		my $jump = qq($script?message=) . &url_encode($message);
5025		&redirect($jump);
5026		exit;
5027		}
5028		&lock('init');
5029		if (! open(SCR,"$script")) {
5030		&dbg(qq(${script}?I?[?v???G???[));
5031		return;
5032		}
5033		my ( $config_start, $config_end);
5034		my @scr = <SCR>;
5035		close(SCR);
5036		my @new_scr = ();
5037		foreach my $line (@scr) {
5038		if ($line =~ /^# config_start/) { $config_start = 1; }
5039		if ($line =~ /^# config_end/) { $config_end = 1; }
5040		if ($config_end \|\| ! $config_start) {
5041		push(@new_scr, $line);
5042		next;
5043		}
5044		if ($line =~ /^\s(my)?\s\$passdir\s=\s/) {
5045		my list($frm,$com) = explode(';',$line);
5046		chomp $com;
5047		$line = 'my $passdir = \'' . $passdir . "';" . $com . "\n";
5048		}
5049		push(@new_scr, $line);
5050		}
5051
5052		# ?????O??o?b?N?A?b?v??? open(INIT,">${script}_bck.cgi") \|\| &error("${script}_bck.cgi??J?????B");
5053		print INIT @scr;
5054		close(INIT);
5055
5056		open(NEW,">$script") \|\| &error("${script}??J?????B");
5057		print NEW @new_scr;
5058		close(NEW);
5059
5060		if (open(CFG,"$config_file")) {
5061		@config_value = <CFG>;
5062		close(CFG);
5063		}
5064		foreach (@config_value) {
5065		my ($name,$value) = split(/<>/);
5066		if ($name eq 'passdir') {
5067		$_ = qq(passdir<>$passdir\n);
5068		}
5069		}
5070		open(CFG,">$config_file") \|\| &error("${config_file}??J?????B");
5071		print CFG @config_value;
5072		close(CFG);
5073
5074		&unlock('init');
5075
5076		my $message = "?p?X???h???f?B???N?g??????????B";
5077		my $jump = qq($script?message=) . &url_encode($message);
5078		&redirect($jump);
5079		exit;
5080		}
5081
5082		sub create_pass {
5083		# $in{'pass'}??rue???script???????p?p?X???h???????? if ($pass) {
5084		if (length($pass) < $pass_length) {
5085		&error('?p?X???h?G???[',"?p?X???h??{pass_length}?????????????B");
5086		}
5087		my $make_passdir = 0;
5088		# .htaccess??g?p?????????passdir???????????v.1.79)
5089		if (! $passdir) {
5090		my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
5091		srand;
5092		for (1 .. 12) {
5093		$passdir .= $salt[int(rand(@salt))];
5094		}
5095		$make_passdir = 1;
5096		}
5097		open(INIT,"$script") \|\| &error('?G???[',"$script??J?????B");
5098		my @init = <INIT>;
5099		close(INIT);
5100		my @new_init = ();
5101		foreach my $line (@init) {
5102		my $tmp = $line;
5103		$tmp =~ s/ //g;
5104		if ($tmp =~ /^(my)?\s\$adminpass\s='/) {
5105		# ???????????p?p?X???h??rypt???pass????????????? my $crypt_pass = &encrypt($pass);
5106		my @tmp = split(/;/,$line);
5107		my $com = pop(@tmp);
5108		my $new_pass = 'my $adminpass = ' . qq(') . $crypt_pass . qq(';) . $com;
5109		push(@new_init,$new_pass);
5110		} elsif ($make_passdir && $tmp =~ /^(my)?\s\$passdir\s='/) {
5111		my @tmp = split(/;/,$line);
5112		my $com = pop(@tmp);
5113		my $new_passdir = 'my $passdir = ' . qq(') . $passdir . qq(';) . $com;
5114		push(@new_init,$new_passdir);
5115		} else {
5116		push(@new_init,$line);
5117		}
5118		}
5119		# ?????O??o?b?N?A?b?v??? open(INIT,">${script}_bck.cgi") \|\| &error('?G???[',"${script}_bck.cgi??J?????B");
5120		print INIT @init;
5121		close(INIT);
5122
5123		# ????? open(INIT,">$script") \|\| &error('?G???[',"${script}??J?????B");
5124		print INIT @new_init;
5125		close(INIT);
5126
5127		# ?p?X???h???f?B???N?g????????????? if (! -d $passdir) {
5128		mkdir $passdir;
5129		}
5130
5131		# ?????????[?U?[???dmin????N?b?L?[????????B
5132		my $id = $admin_id;
5133		&set_cookie($id,$pass,param('save_cook'));
5134
5135		# ???_?C???N?g
5136		if ($ENV{PERLXS} eq "PerlIS") {
5137		print "HTTP/1.0 302 Temporary Redirection\r\n";
5138		print "Content-type: text/html\n";
5139		}
5140		my $comment = qq(??????p?X???h????????B?????????[?U?[???strong>${id}</strong>???B<br />??????O?C?????????[?U?[???A??????????p?X???h????O?C?????????B);
5141		$login_admin = &random_str();
5142		my $logindir = join('/',$passdir,'login');
5143		mkdir $logindir if ! -d $logindir;
5144		my $login_file = $ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi';
5145		my $login_path = join('/',$logindir,$login_file);
5146		open(LGI,">$login_path") \|\| die "$!";
5147		print LGI $id;
5148		close(LGI);
5149		print qq(Location: $script?mode=admin&login_admin=$login_admin&comment=) . &url_encode($comment) . qq(\n\n);
5150		exit;
5151		}
5152		&header;
5153		print qq(<div style="text-align:center;margin:1em">);
5154		print qq(<p>??????p?p?X???h??????????B</p>\n);
5155		print qq(<form action="$script" method="post">\n);
5156		print qq(?p?X???h <input type="password" name="pass" value="" size="10" />\n);
5157		print qq(<input type="submit" value="?o?^" />\n);
5158		print qq(</form>\n);
5159		print qq(</div>);
5160		&footer;
5161		}
5162
5163		sub login {
5164		my $mode = $_[0];
5165		my $comment = $_[1];
5166		$mode = 'login' if ! $mode \|\| $mode eq 'history';
5167		my $html;
5168		if (param('cancel')) {
5169		&redirect($script);
5170		exit;
5171		}
5172
5173		# ?u?V?K?o?^???v?{?^???????????A?o?^?t?H?[????\??
5174		if (param('usr_regist')) {
5175		$title .= ' ?\|?V?K?o?^?\|';
5176		# ???[?U?[??A?p?X???h??????u?o?^?v?{?^???????????A?o?^????s?? if (param('new_id') && param('new_pass') && ! param('auto_pass') && ! param('use_pass')) {
5177		if (length(param('new_pass')) < $pass_length) {
5178		&error('?p?X???h?G???[',"?p?X???h??{pass_length}?????????????);
5179		}
5180		if (param('new_id') eq $admin_id) {
5181		&error('???[?U?[??G???[',"???[?U?[???{admin_id}??g?p??????B????O????????);
5182		}
5183		if (length(param('new_id')) > $max_user_id) {
5184		&error('???[?U?[??G???[',"???[?U?[????p??{max_user_id}????A?S?p?? . (int($max_user_id / 2)) . '?????????????B');
5185		}
5186		if ($use_htaccess && param('new_id') =~ /:/) {
5187		&error('???[?U?[??G???[','???[?U?[???(?R????)??g?????????B');
5188		}
5189		&lock();
5190		open(USR,"./user.cgi");
5191		my @user = <USR>;
5192		close(USR);
5193		foreach (@user) {
5194		my ($tm, $user, $path, $e_pass, $permit, $l_size) = split(/\,/);
5195		$user = &rechange($user);
5196		if ($user eq param('new_id')) {
5197		&error(qq(${user}?????o?^?????B),qq(?\\????????????[?U?[????X???????B));
5198		}
5199		}
5200		if ($user_mail_neces && ! param('new_mail')) {
5201		&error("???[???A?h???X???L????B","???[???A?h???X??K?{????????B???[???A?h???X??L????A????x?o?^???????B");
5202		}
5203		if ($chk_mail) {
5204		require './email_chk.pl';
5205		if (param('new_mail') && ! &email_chk(param('new_mail'))) { &error('?G???[',"???[???A?h???X????????????????B"); }
5206		}
5207		if (! -d $user_root) {
5208		mkdir $user_root;
5209		}
5210		my $index = join('/',$user_root,'index.html');
5211		if ($make_index && ! -f $index) {
5212		open(INDX,">$index");
5213		close(INDX);
5214		}
5215		my $mkd_suc = 0;
5216		my $enc_pass;
5217		for (my $mkd=1; $mkd<=5; $mkd++) {
5218		$enc_pass = &encrypt(param('new_pass'));
5219		if ($enc_pass =~ /\// \|\| $enc_pass =~ /\./) {
5220		# ?f?B???N?g???????????????G???[????????????????? next;
5221		}
5222		# ???????p?X???h??f?B???N?g??????p??????AMD5????????????enc_pass???????????????A13???????l??? $path = join('/',$user_root,substr($enc_pass,0,13));
5223		if (mkdir $path) {
5224		$mkd_suc = 1;
5225		my $index = join('/',$path,'index.html');
5226		if ($make_index && ! -f $index) {
5227		open(INDX,">$index");
5228		close(INDX);
5229		}
5230		last;
5231		}
5232		}
5233		&error("?o?^?????????B","?p?X???h???X??????x?o?^???????B$path") if ! $mkd_suc;
5234		my $time = time;
5235		my $limit_size = 1024 * 1024 * $max_mb;
5236		my $new_id = &change(param('new_id'));
5237		my $new_line = join(',', $time, $new_id, $path, $enc_pass, 3, $limit_size, param('new_mail'),$auto_delete,$max_dl_count);
5238		$new_line .= ",\n";
5239		push(@user,$new_line);
5240		open(USR,">./user.cgi");
5241		print USR @user;
5242		close(USR);
5243
5244		my $pass_file_path = join('/', $passdir, 'upload/usr_root', substr($enc_pass,0,13), '.htpasswd'); # ?p?X???h?t?@?C????p?X
5245		if ($use_htaccess) {
5246		my $pass_file_dir = $pass_file_path;
5247		$pass_file_dir =~ s/\/\.htpasswd//;
5248		&make_dir($pass_file_dir) if ! -d $pass_file_dir; # ?p?X???h?t?@?C????u??f?B???N?g????????????? my $pass_file = qq($fullpath/$pass_file_path);
5249		my $hta_str = <<"EOF";
5250		AuthType Basic
5251		AuthName "?}???`?A?b?v???[?h?F?
5252		AuthUserFile $pass_file
5253		require valid-user
5254		<Files ~ "^.(htpasswd\|htaccess)$">
5255		deny from all
5256		</Files>
5257		EOF
5258		my $htac = join('/', $path, $htaccess);
5259		open(HTA,">$htac");
5260		print HTA $hta_str;
5261		close(HTA);
5262		##.htpasswd??? open(PSS,">$pass_file_path");
5263		print PSS param('new_id') . qq(:$enc_pass\n);
5264		print PSS qq($admin_id:$adminpass);
5265		close(PSS);
5266		}
5267		my $e_new_raw_pass = &change(param('new_pass'));
5268		my $new_raw_pass = join(',',$time,$e_new_raw_pass) . ',';
5269		my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
5270		open(RAW,">>$raw_pass_path");
5271		print RAW $new_raw_pass . "\n";
5272		close(RAW);
5273		&unlock();
5274
5275		$html .= qq(<div style="text-align:center;margin:1em">) . param('new_id') . qq(${mr}??o?^?????B</div>\n);
5276		my $cid = param('new_id');
5277		my $cpass = param('new_pass');
5278		my $mail = param('new_mail');
5279		my $send_mail;
5280		if ($mail) {
5281		$send_mail = qq(<tr><td style="text-align:right;"><input type="checkbox" name="regist_mail" id="regist_mail" value="1" tabindex="5" /></td><td align="left"><label for="regist_mail">?o?^??e??mail????M???/label></td></tr>);
5282		}
5283		$html .= <<"EOF";
5284		<div style="text-align:center;">
5285		<form action="$script" method="post">
5286		<input type="hidden" name="mode" value="$mode" />
5287		<table style="margin:auto" summary="???O?C???t?H?[??">
5288		<tr><td colspan="2"style="text-align:center;"><input type="submit" value="???O?C??" tabindex="1" /></td></tr>
5289		<tr><td align="right">???[?U?[??/td><td align="left"><input type="text" name="id" value="$cid" style="width:120px;height:16px" tabindex="2" /></td></tr>
5290		<tr><td align="right">?p?X???h</td><td align="left"><input type="password" name="pass" value="$cpass" style="width:120px;height:16px" tabindex="3" /></td></tr>
5291		<tr><td style="text-align:right;"><input type="checkbox" name="save_cook" id="save_cook" value="1" tabindex="4" /></td><td align="left"><label for="save_cook">?o?^??e??N?b?L?[??????/label></td></tr>
5292		$send_mail
5293		</table>
5294		</form>
5295		</div>
5296		EOF
5297		if ($mail_notify && @admin_mail) {
5298		my ($mail_title, @msg, $msg);
5299		$mail_title = '?y' . $simple_title . '?z' . param('new_id') . "${mr}?o?^";
5300		my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
5301		$year+=1900;
5302		$mon++;
5303		my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
5304		@msg = &read_file('./mail_template/u2a_new.txt');
5305		$msg = join('',@msg);
5306		my $url = url;
5307		my $new_user = param('new_id');
5308		my $dir = $url . qq(?dir=) . join('/', $updir, 'usr_root', $enc_pass,);
5309		$msg =~ s/<date>/$tm_com/g;
5310		$msg =~ s/<title>/$simple_title/g;
5311		$msg =~ s/<user>/$new_user/g;
5312		$msg =~ s/<mr>/$mr/g;
5313		$msg =~ s/<url>/$url/g;
5314		$msg =~ s/<dir>/$dir/g;
5315		foreach (@admin_mail) {
5316		&notify($mail_title, $msg, $_);
5317		}
5318		}
5319		} else {
5320		my $mail_nec;
5321		$mail_nec = '<span style="color:red;font-size:80%">??K?{</span>' if $user_mail_neces;
5322		my ($auto_pass,$auto_pass_com,$hidden) = &auto_pass_frm;
5323		my $new_id = param('new_id');
5324		my $new_pass = param('new_pass');
5325		$new_pass = $auto_pass if $auto_pass;
5326		my $new_mail = param('new_mail');
5327		my $chr;
5328		$html .= <<"EOF";
5329		<div style="text-align:center;margin:1em">
5330		?o?^?????[?U?[??A?p?X???h??????u?o?^?v?{?^????????????<form action="$script" method="post">
5331		<input type="hidden" name="mode" value="$mode" />
5332		<input type="hidden" name="usr_regist" value="1" />
5333		$hidden
5334		<table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="?V?K?o?^?t?H?[??">
5335		<tr><td colspan="2" style="text-align:center;"><input type="submit" value="?o?@?^" tabindex="1" />  <input type="submit" name="cancel" value="?L?????Z??" tabindex="2" /></td></tr>
5336		<tr><td align="right">???[?U?[??span style="color:red;font-size:80%">??K?{$chr</span></td><td align="left"><input type="text" name="new_id" value="$new_id" style="width:120px;height:16px" tabindex="3" /></td></tr>
5337		<tr><td align="right">?p?X???h<span style="color:red;font-size:80%">??K?{</span></td><td align="left"><input type="text" name="new_pass" value="$new_pass" style="width:120px;height:16px" tabindex="4" /></td></tr>
5338		$auto_pass_com
5339		<tr><td colspan="2" style="text-align:right;"><span style="font-size:80%">??p?X???h??/span> <span style="font-weight:bold;font-size:120%">$ban</span> <span style="font-size:80%">??g?p?????????/span>
5340		</td></tr>
5341		<tr><td align="right">???[???A?h???X$mail_nec</td><td align="left"><input type="text" name="new_mail" value="$new_mail" style="ime-mode:disabled; width:120px;height:16px" tabindex="5" /></td></tr>
5342		</table>
5343		</form>
5344		</div>
5345		EOF
5346		}
5347		# ???O?C???t?H?[????\??
5348		} else {
5349		my ($cid,$cpass,$cuse_cook) = &get_cookie;
5350		if (!$cid && $id) { $cid = $id; }
5351		if (!$cpass && $pass) { $cpass = $pass; }
5352		my ($hidden, $pass_name);
5353		if (param('dir')) { $hidden .= qq(<input type="hidden" name="dir" value=") . param('dir') . qq(" />); }
5354		if (param('time')) {
5355		$hidden .= qq(<input type="hidden" name="time" value=") . param('time') . qq(" />);
5356		$pass_name = 'tpass';
5357		$cpass = param('tpass');
5358		$cid = param('id') if param('id');
5359		} else {
5360		$pass_name = 'pass';
5361		}
5362		if (param('file')) { $hidden .= qq(<input type="hidden" name="file" value=") . param('file') . qq(" />); }
5363		my $message;
5364		if (param('message')) { $message = '<div style="color:red">' . param('message') . '</div>'; }
5365		if ($comment) { $message .= '<div style="color:red">' . $comment . '</div>'; }
5366		my $chk = '';
5367		if ($cuse_cook) { $chk = qq( checked="checked"); }
5368		my $return;
5369		if ($show_return) {
5370		if ($return_url) {
5371		if ($return_name) {
5372		$return = qq(<a href="$return_url">${return_name}????/a> );
5373		} else {
5374		$return = qq(<a href="$return_url">?O??y?[?W????/a> );
5375		}
5376		} else {
5377		$return = qq(<a href="javascript:history.back()">?O??y?[?W????/a> );
5378		}
5379		}
5380		$cid = param('dptid') if param('dptid');
5381		$html .= <<"EOF";
5382		<div style="text-align:center;">
5383		<form action="$script" method="post">
5384		<input type="hidden" name="mode" value="$mode" />
5385		$hidden
5386		$message
5387		<table style="margin:auto" summary="???O?C???t?H?[??">
5388		<tr><td colspan="2" style="text-align:center;">$return<input type="submit" value="???O?C??" tabindex="1" /></td></tr>
5389		<tr><td style="text-align:right;">???[?U?[??/td><td align="left"><input type="text" name="id" value="$cid" style="width:120px;height:16px" tabindex="2" /></td></tr>
5390		<tr><td style="text-align:right;">?p?X???h</td><td align="left"><input type="password" name="$pass_name" value="$cpass" style="width:120px;height:16px" tabindex="3" /></td></tr>
5391		<tr><td style="text-align:right;"><input type="checkbox"$chk name="save_cook" id="save_cook" value="1" tabindex="4" /></td><td align="left"><label for="save_cook">?N?b?L?[??g?p???/label></td></tr>
5392		</table>
5393		</form>
5394		</div>
5395		EOF
5396		if ($user_regist) {
5397		$html .= qq(<div style="margin-top:2em;text-align:center;">\n);
5398		$html .= qq(<form action="$script" method="post"><input type="hidden" name="usr_regist" value="1" /><input type="submit" value="?V?K?o?^??? tabindex="5" /></form>\n);
5399		$html .= qq(</div>\n);
5400		}
5401		}
5402		if (param('new_id') && param('new_pass')) {
5403		&set_cookie(param('new_id'), param('new_pass'),param('save_cook'));
5404		}
5405		&header;
5406		print $html;
5407		&footer;
5408		}
5409
5410
5411		sub change {
5412		my $str = $_[0];
5413		$str =~ s/\,/,/g;
5414		$str;
5415		}
5416
5417
5418		sub rechange {
5419		my $str = $_[0];
5420		$str =~ s/,/,/g;
5421		$str;
5422		}
5423
5424
5425		#-------------------------------------------------
5426		# ?p?X???h?????
5427		#-------------------------------------------------
5428		sub encrypt_old {
5429		my($inpw) = $_[0];
5430		my(@SALT, $salt, $encrypt);
5431		if ($inpw =~ /([$ban])/) {
5432		&error("?p?X???h?G???[","?u$1?v??p?X???h???????????B");
5433		}
5434		@SALT = ('a'..'z', 'A'..'Z', '0'..'9');
5435		srand(int(rand(100000)));
5436		$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5437		$encrypt = crypt($inpw, $salt) \|\| crypt ($inpw, '$1$' . $salt);
5438		$encrypt;
5439		}
5440
5441		sub encrypt {
5442		my($inpw) = $_[0];
5443		if ($inpw =~ /([$ban])/) {
5444		&error("?p?X???h?G???[","?u$1?v??p?X???h???????????B");
5445		}
5446		my $encrypt;
5447		if ($code == 2) {
5448		use Digest::MD5 qw/md5_hex/;
5449		my @str = ('a' .. 'f', 0 .. 9);
5450		my $salt;
5451		for (1 .. 8) {
5452		$salt .= $str[int(rand(@str))];
5453		}
5454		$encrypt = $salt . md5_hex($salt . $inpw);
5455		} else {
5456		my(@SALT, $salt);
5457		@SALT = ('a'..'z', 'A'..'Z', '0'..'9');
5458		srand(int(rand(100000)));
5459		$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5460		$encrypt = crypt($inpw, $salt) \|\| crypt ($inpw, '$1$' . $salt);
5461		if (length($inpw) > 8) {
5462		my $inpw2 = substr($inpw,8,8);
5463		srand(int(rand(100000)));
5464		my $salt2 = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5465		my $encrypt2 = crypt($inpw2, $salt2) \|\| crypt ($inpw2, '$1$' . $salt2);
5466		$encrypt .= $encrypt2;
5467		}
5468		}
5469		$encrypt;
5470		}
5471
5472
5473		#-------------------------------------------------
5474		# ?p?X???h????
5475		#-------------------------------------------------
5476		sub decrypt_old {
5477		my($inpw, $logpw) = @_;
5478		my($salt, $check);
5479		$salt = $logpw =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw, 0, 2);
5480		$check = "no";
5481		if (crypt($inpw, $salt) eq $logpw \|\| crypt($inpw, '$1$' . $salt) eq $logpw)
5482		{ $check = "yes"; }
5483		$check;
5484		}
5485
5486		sub decrypt {
5487		my($inpw, $logpw) = @_;
5488		my($salt, $check);
5489		if (length($logpw) == 40) {
5490		# salt????????????o??
5491		my $salt = substr($logpw, 0, 8);
5492		$check = "no";
5493		# ??
5494		if ($logpw eq ($salt . md5_hex($salt . $inpw))) {
5495		$check = "yes";
5496		}
5497		} else {
5498		my $logpw1 = substr($logpw,0,13);
5499		my $inpw1 = substr($logpw,0,8);
5500		$salt = $logpw1 =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw1, 0, 2);
5501		$check = "no";
5502		if (crypt($inpw, $salt) eq $logpw1 \|\| crypt($inpw1, '$1$' . $salt) eq $logpw1) {
5503		$check = "yes";
5504		}
5505		if ($check eq "yes" && length($logpw) == 26) {
5506		my $logpw2 = substr($logpw,13,13);
5507		my $inpw2 = substr($inpw,8,8);
5508		my $salt2 = $logpw2 =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw2, 0, 2);
5509		if (crypt($inpw2, $salt2) eq $logpw2 \|\| crypt($inpw2, '$1$' . $salt2) eq $logpw2) {
5510		$check = "yes";
5511		} else {
5512		$check = "no";
5513		}
5514		}
5515		}
5516		$check;
5517		}
5518
5519
5520		sub auto_pass {
5521		my ($length,$al,$dg,$mk) = @_;
5522		my $auto_pass;
5523		$length = 8 if ! $length;
5524		$al = 1 if ! $al && ! $dg && ! $mk;
5525		my @salt = ();
5526		if ($al) {
5527		push(@salt,('a'..'z', 'A'..'Z'));
5528		}
5529		if ($dg) {
5530		push(@salt,('0'..'9'));
5531		}
5532		if ($mk) {
5533		push(@salt,('\\','!','$','%','\'','$','$','=','-','^','~','`',':','*','?','/','_','<','>','\,','.','\|','[',']','{', '}','?,'?,'?,'@'));
5534		}
5535		srand;
5536		for (1 .. $length) {
5537		$auto_pass .= $salt[int(rand(@salt))];
5538		}
5539		return $auto_pass;
5540		}
5541
5542
5543		sub auto_pass_frm {
5544		my ($auto_pass, $auto_path_str, $auto_pass_frm,$al,$dg,$mk,$al_chk,$dg_chk,$mk_chk,$hidden);
5545		my $tindx = $_[0];
5546		$auto_path_str = "?p?X???h????????;
5547		if (param('auto_pass')) {
5548		$auto_path_str = "?p?X???h???;
5549		$al = param('al');
5550		$dg = param('dg');
5551		$mk = param('mk');
5552		if (! param('auto_pass_re')) {
5553		$al = 1;
5554		$dg = 1;
5555		$mk = 1;
5556		}
5557		if (! $al && ! $dg && ! $mk) {
5558		$al = 1;
5559		}
5560		my $length_com = qq(<select name="length">\n);
5561		my $length = param('length');
5562		$length = 10 if ! $length;
5563		for (my $i=$pass_length; $i <= ($auto_pass_length + 10); $i++) {
5564		my $sel;
5565		if ($length == $i) {
5566		$sel = qq( selected="selected");
5567		}
5568		$length_com .= qq(<option value="$i"$sel>$i</option>);
5569		}
5570		$length_com .= qq(</select>???);
5571		$auto_pass = &auto_pass($length, $al, $dg, $mk);
5572		$al_chk = qq( checked="checked") if $al;
5573		$dg_chk = qq( checked="checked") if $dg;
5574		$mk_chk = qq( checked="checked") if $mk;
5575		$hidden = qq(<input type="hidden" name="auto_pass_re" value="1" />\n);
5576		if ($auto_pass) {
5577		$hidden .= qq(<input type="hidden" name="pass_gene" value="$auto_pass" />\n);
5578		$auto_path_str = "?p?X???h????;
5579		my $e_auto_pass = $auto_pass;
5580		$e_auto_pass =~ s/</</g;
5581		$e_auto_pass =~ s/>/>/g;
5582		}
5583		$auto_pass_frm .= qq(<tr><td style="text-align:right;"><input type="submit" name="auto_pass" value="$auto_path_str" style="font-size:80%" tabindex="$tindx" /></td>); $tindx++;
5584		$auto_pass_frm .= qq(<td><input type="checkbox" name="al"$al_chk id="al" value="1" tabindex="$tindx" /><label for="al">?p</label> ); $tindx++;
5585		$auto_pass_frm .= qq(<input type="checkbox" name="dg"$dg_chk id="dg" value="1" tabindex="$tindx" /><label for="dg">??</label> ); $tindx++;
5586		$auto_pass_frm .= qq(<input type="checkbox" name="mk"$mk_chk id="mk" value="1" tabindex="$tindx" /><label for="mk">?L</label> $length_com</td></tr>\n); $tindx++;
5587		$auto_pass_frm .= qq(</td></tr>\n);
5588		} else {
5589		$auto_pass_frm = qq(<tr><td colspan="2" style="text-align:center;"><input type="submit" name="auto_pass" value="$auto_path_str" style="font-size:80%" tabindex="$tindx" /></td></tr>\n); $tindx++;
5590		}
5591		return($auto_pass,$auto_pass_frm,$hidden,$tindx);
5592		}
5593
5594
5595		sub error {
5596		$error_header = 1;
5597		if ($lockflag) {
5598		&unlock($lockfile);
5599		}
5600		&header;
5601		print qq(<div style="margin:1em">\n);
5602		print "<h1>$_[0]</h1>\n";
5603		print "<div style=\"font-size:120%\">$_[1]</div><p>\n";
5604		print "?u???E?U??????{?^????????O?????????????</p>\n";
5605		print qq(</div>\n);
5606		&footer;
5607		exit;
5608		}
5609
5610
5611
5612
5613		#?T?C?Y???sub size_measure {
5614		my($path) = shift;
5615		my($size) = 0;
5616		my(@dir);
5617		opendir(DIR, $path) or return;
5618		while(my $entry = readdir(DIR)){
5619		next if $entry eq '.' \|\| $entry eq '..';
5620		if(-d "$path/$entry"){
5621		push(@dir, $entry);
5622		$dir_nmb++;
5623		} else {
5624		$size +=(-s "$path/$entry");
5625		$file_nmb++;
5626		}
5627		}
5628		closedir(DIR);
5629		foreach my $temp(@dir){
5630		$size += &size_measure("$path/$temp");
5631		}
5632		return $size;
5633		}
5634
5635		sub kiro_byte {
5636		my $byte = $_[0];
5637		if ($byte ne '') {
5638		if ($byte / 10 >= 1024 *1024) {
5639		return int($byte / (1024 *1024)) . 'MB';
5640		} elsif ($byte >= 1024) {
5641		return &comma(int($byte / 1024)) . 'KB';
5642		} else {
5643		if ($byte) {
5644		return $byte . 'byte';
5645		} else {
5646		return $byte;
5647		}
5648		}
5649		}
5650		}
5651
5652
5653
5654		sub save_accesslog {
5655		my($tm) = shift;
5656		my($check);
5657		my($retrytime) = 5;
5658		my($retrynum) = 10;
5659
5660		my($time) = &presenttime;
5661		my($host) = $ENV{'REMOTE_HOST'};
5662		my($addr) = $ENV{'REMOTE_ADDR'};
5663		if ($host eq "" \|\| $host eq "$addr") {
5664		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
5665		if ($host eq "") { $host = $addr; }
5666		}
5667		my $tmp_id = &change($id);
5668		$tmp_id .= qq\|(?????)\| if $administrator;
5669		$tmp_id .= qq\|(?Q?X?g)\| if $tpass \|\| $login_guest;
5670		my($str) = "$tmp_id,$time,$host,$tm,\n";
5671		my @access = ();
5672
5673		if (!-e $access) {
5674		open(NEW,">$access");
5675		close(NEW);
5676		}
5677		if ($lock) { &lock('acc.lock'); }
5678		if (open ACCE, "$access") {
5679		@access = <ACCE>;
5680		close(ACCE);
5681		}
5682		unshift(@access, $str);
5683		if($save_num){
5684		@access = splice(@access, 0, $save_num);
5685		}
5686		if (open(ACC,">$access")) {
5687		print ACC @access;
5688		close(ACC);
5689		}
5690		if (! -d $access_dir) {
5691		mkdir $access_dir;
5692		}
5693		my $log_path = join('/',$access_dir,$tm);
5694		if ($administrator) {
5695		$log_path .= 'a';
5696		} elsif ($tpass \|\| $login_guest) {
5697		$log_path .= 't';
5698		}
5699		$log_path .= '.cgi';
5700		if (open(LOG,"$log_path")) {
5701		# ???O??s????save_num?s????l???@???????????? my @acclog = <LOG>;
5702		close(LOG);
5703		my $ofs = $save_num -1;
5704		$ofs = scalar(@acclog) if $ofs > scalar(@acclog);
5705		$ofs *= -1;
5706		@acclog = splice(@acclog, $ofs, $save_num);
5707		open(LOG,">$log_path");
5708		print LOG @acclog;
5709		close(LOG);
5710		}
5711		open(LOG, ">>$log_path");
5712		print LOG $str;
5713		close(LOG);
5714		if ($lock) { &unlock('acc.lock'); }
5715		}
5716
5717
5718		sub presenttime {
5719		my $tm = $_[0];
5720		$tm = time if ! $tm;
5721		my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($tm);
5722		my @youbi = ("??, "??, "??, "??", "??, "??, "?y");
5723		$wday = $youbi[$wday];
5724		$year += 1900;
5725		$month++;
5726		my($time) = sprintf("%04d/%01d/%01d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
5727		return ($time);
5728		}
5729
5730
5731		sub set_cookie {
5732		my(@cook) = @_;
5733		my($gmt, $cook, @t, @m, @w);
5734
5735		@t = gmtime(time + 602460*$c_val_term);
5736		@m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
5737		@w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
5738
5739		# ????W?????`
5740		$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
5741		$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
5742
5743		#
5744		my $save_cokkie = $cook[2];
5745		if (!$save_cokkie) {
5746		@cook = ();
5747		}
5748
5749		# ???f?[?^??RL?G???R?[?h
5750		foreach (@cook) {
5751		s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
5752		$cook .= "$_<>";
5753		}
5754
5755		# ?i?[
5756		print "Set-Cookie: $cookname=$cook; expires=$gmt\n";
5757		}
5758
5759		#-------------------------------------------------
5760		# ?N?b?L?[???#-------------------------------------------------
5761		sub get_cookie {
5762		my($key, $val, %cook, $cook, @cook);
5763
5764		# ?N?b?L?[???? $cook = $ENV{'HTTP_COOKIE'};
5765
5766		# ?Y??ID????o?? foreach ( split(/;/, $cook) ) {
5767		($key, $val) = split(/=/);
5768		$key =~ s/\s//g;
5769		$cook{$key} = $val;
5770		}
5771
5772		# ?f?[?^??RL?f?R?[?h?????? foreach ( split(/<>/, $cook{"$cookname"}) ) {
5773		s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
5774		push(@cook,$_);
5775		}
5776		return (@cook);
5777		}
5778
5779		sub comma {
5780		my $text = reverse $_[0];
5781		$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
5782		return scalar reverse $text;
5783		}
5784
5785		sub get_unique {
5786		my(%count,@list);
5787		@list = @_;
5788		my @unique_list = grep(!$count{$_}++, @list);
5789		return @unique_list;
5790		}
5791
5792
5793
5794		sub lock {
5795		mkdir $lockdir if ! -d $lockdir;
5796		my $lck = $_[0];
5797		if ($lck) {
5798		$lockfile = $lck;
5799		} else {
5800		$lck = $lockfile;
5801		}
5802		my $lockpath = "$lockdir/$lck";
5803
5804		# 1????????b?N??????? if (-e $lockpath) {
5805		my($mtime) = (stat($lockpath))[9];
5806		if ($mtime < time - 60) { &unlock; }
5807		}
5808		my $retry = 5;
5809		my $e_mes = "<br />?????????????x???s???????B";
5810		# symlink????????b?N
5811		if ($lockkey == 1) {
5812		while (!symlink(".", $lockpath)) {
5813		if (--$retry <= 0) { &error('?G???[','Lock is busy'); }
5814		sleep(1);
5815		}
5816		# mkdir????????b?N
5817		} elsif ($lockkey == 2) {
5818		while (!mkdir($lockpath, 0755)) {
5819		if (--$retry <= 0) { &error("Lock is busy","$e_mes"); }
5820		sleep(1);
5821		}
5822		}
5823		$lockflag = 1;
5824		}
5825
5826
5827		sub unlock {
5828		my $lck = $_[0];
5829		if ($lck) {
5830		$lockfile = $lck;
5831		} else {
5832		$lck = $lockfile;
5833		}
5834		my $lockpath = "$lockdir/$lck";
5835		if ($lockkey == 1) { unlink($lockpath); }
5836		elsif ($lockkey == 2) { rmdir($lockpath); }
5837		$lockflag=0;
5838		}
5839
5840
5841		sub url_param {
5842		my %param = @_;
5843		my $count = 0;
5844		my $url;
5845		foreach (sort keys %param) {
5846		if ($param{"$_"}) {
5847		if (! $count) {
5848		$url .= "?" . $_ . qq(=$param{"$_"});
5849		$count++;
5850		} else {
5851		$url .= "&" . $_ . qq(=$param{"$_"});
5852		}
5853		}
5854		}
5855		return $url;
5856		}
5857
5858
5859		sub hidden_param {
5860		my %param = @_;
5861		my $hidden;
5862		foreach (sort keys %param) {
5863		if ($param{"$_"}) {
5864		my $decode = &url_decode($param{"$_"});
5865		$hidden .= qq(<input type="hidden" name="$_" value="$decode" />\n);
5866		}
5867		}
5868		return $hidden;
5869		}
5870
5871		# delete.log????
5872		sub delete_log {
5873		my @del_list = @_;
5874		&lock('delete.lock');
5875		if (open(DEL,">>./delete.log")) {
5876		foreach (@del_list) {
5877		print DEL time . qq(<>$_\n);
5878		}
5879		close(DEL);
5880		}
5881		# ?e??00KB????? if ((stat('./delete.log'))[7] > 1024 * 100) {
5882		opendir(DIR,'.');
5883		my $max_ex = 0;
5884		while (my $file = readdir(DIR)) {
5885		if ($file =~ /\.(\d{3}$)/) {
5886		if ($1 > $max_ex) {
5887		$max_ex = $1;
5888		}
5889		}
5890		}
5891		closedir(DIR);
5892		$max_ex++;
5893		my $ext = sprintf("%03d",$max_ex);
5894		rename './delete.log','./delete.' . $ext;
5895		}
5896		&unlock('delete.lock');
5897		}
5898
5899
5900		sub get_millisec {
5901		return (times)[0];
5902		}
5903
5904		sub get_microsec {
5905		use Time::HiRes qw(gettimeofday);
5906		my ($sec, $microsec) = gettimeofday;
5907		return ($sec, $microsec);
5908		}
5909
5910
5911		sub time_format {
5912		my ($sec,$msec) = @_;
5913		my ($hour,$min,$com);
5914		if ($sec > 3600) {
5915		$hour = int($sec / 3600);
5916		$sec -= $hour * 3600;
5917		}
5918		if ($sec > 60) {
5919		$min = int($sec / 60);
5920		$sec -= $min * 60;
5921		}
5922		$com .= qq(${hour}??? if $hour;
5923		$com .= qq(${min}?? if $min;
5924		$msec = sprintf("%.2f",$msec/1000000);
5925		$com .= ($sec + $msec) . '?b';
5926		}
5927
5928
5929		sub key_color {
5930		my ($str,$key) = @_;
5931		return $str if ! $key;
5932		my $ascii = '[\x00-\x7F]';
5933		my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
5934		my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
5935		if ($encode_lib == 1) {
5936		eval 'use Jcode;';
5937		Jcode::convert(\$str, "euc");
5938		Jcode::convert(\$key, "euc");
5939		} else {
5940		require 'jcode.pl';
5941		&jcode::convert(\$str, "euc");
5942		&jcode::convert(\$key, "euc");
5943		}
5944		my $replace = qq(<span style="background-color:#ffffcc;color:#ff0000">$key</span>);
5945		$str =~ s/\G((?:$ascii\|$twoBytes\|$threeBytes)*?)(?:$key)/$1$replace/g;
5946		if ($encode_lib == 1) {
5947		Jcode::convert(\$str, "sjis");
5948		} else {
5949		&jcode::convert(\$str, "sjis");
5950		}
5951		return $str;
5952		}
5953
5954
5955		sub random_str{
5956		my $length = $_[0];
5957		$length = 10 if ! $length;
5958		my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
5959		srand;
5960		my $login_id;
5961		for (1 .. $length) {
5962		$login_id .= $salt[int(rand(@salt))];
5963		}
5964		return $login_id
5965		}
5966
5967
5968


パターン	'/	/'	'//'
置換	'	'	''