※機能制限した見本版です。(このディレクトリから移動できません。置換ファイルはphpではなく、txtファイルになります。ファイルや置換パターンを編集しても10分で元に戻ります。)
ファイル一覧を隠す
上のディレクトリへ上のディレクトリへ
ファイルcalendar.cgi
ファイルmultiupload.cgi
サブディレクトリsubdir
 multiupload.cgiを選択中
SJIS EUC-JP UTF-8 JIS 
SJISと判定しましたが、文字化けしている場合は手動で選択してください。
--------------------------------------------------------------------------------------------------
■以下の変数名はスカラーや配列で重複して使用されています。変数のタイプが違う場合、別名に変更してください。
一括で変換
変数名スカラー配列ハッシュ 
history historyを編集
admin_mail admin_mailを編集
ver verを編集
access accessを編集
pathpathを編集
mode modeを編集
subdir subdirを編集
sort sortを編集
pass passを編集
user userを編集
dir dirを編集
param paramを編集
mailmailを編集
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を編集
cookcookを編集
dir_user dir_userを編集
--------------------------------------------------------------------------------------------------
■以下の書式を変換します 
qq() → "" 715件 
my 除去 839件
my ()除去 134件
ハッシュから連想配列へ 276件
eq → === 130件
ne → !== 35件
elsif → elseif 72件
ループ中のnext → continue 9件
行末のifを変換 216件
ループ中のlast → break 22件
sub func { → function() { 74件
(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件
関数呼び出し変更 423件
配列の要素数 17件
foreach文変更(要素名指定) 24件
foreach文変更(要素名省略) 75件
foreach (keys %ハッシュ)の変換 3件
配列初期化 17件
配列の@を$に変更(代入あり) 43件
配列の@を$に変更 338件
ハッシュの%を$に変更(代入あり) 51件
文字列を分割して複数の変数に代入 15件
複数の変数に代入 60件
split → explode(要素名指定) 25件
split → explode(要素名省略) 44件
join修正 76件
mkdirに()をつける 14件
unlinkに()をつける 20件
カレントディレクトリを得る 1件
文字列中の配列要素を分離 52件
$ENV[環境変数] 15件
--------------------------------------------------------------------------------------------------
上記の置換パターンを編集する
パターン'//''//'
置換''''
--------------------------------------------------------------------------------------------------
現在のmultiupload.cgiの内容
1 #!/usr/local/bin/perl
2 #################################################################
3 # マルチアップロードCGI #
4 #################################################################
5 my $explain = <<"EOF";
6 cgi.pmを使ってファイルをアップロードするCGIです。複数のファイルを同時にアップロードできます。
7 アップロードできるファイルのサイズ、種類に特に制限はありませんが、CGIファイルは管理者と許可されたユーザーのみアップロードできます。
8 全角文字のファイル名だと文字化けする場合があるので、URLエンコードしてアップロードし、ブラウザでファイル名を表示する場合はURLデコードしています。
9 登録ユーザーのみアクセス可能で、ユーザーごとにアクセスできるディレクトリ、アップロード可能な容量、可能な操作の設定ができます。
10 可能な操作は以下の通りです。
11 ファイルのアップロード、ダウンロードと削除、サブディレクトリの作成、削除、パーミッションの変更。ファイル、ディレクトリのディレクトリ内移動(1階層ずつ)
12 【以下管理者のみ】
13 ユーザーの追加、設定内容変更。ユーザーのアクセスログの保存、閲覧。
14 管理者パスワードの変更。
15 アップロードされて指定日数が経過したファイルの一括削除。
16 EOF
17 #===============================================================
18 my $history = <<'EOF';
19 ver.1.00    2010.03.31    作成
20 ver.1.01    2010.04.01    日本語名のファイルをアップロードする際、文字が切れる場合があるので、いったんeucに変換後、再度sjisに変換することにする。
21 ver.1.1        2010.04.02    パスワード制限、ユーザー管理機能などを追加。
22 ver.1.11    2010.04.05    クッキー機能、パーミッション修正機能を追加。
23 ver.1.12    2010.04.06    制限容量を超えてアップロードしようとしたときの処理を追加。
24 ver.1.13    2010.04.12    同じユーザー名の登録があった場合に対応して、管理画面での編集対象アカウントを名前でなく登録日時エポック時間で選択するよう修正。
25 ver.1.14    2010.04.13    登録ユーザーのディレクトリで既存のディレクトリより2階層以上深いディレクトリを作成できなかったのを修正。
26 ver.1.15    2010.04.14    ファイル、ディレクトリの移動機能を追加。
27 ver.1.16    2010.04.19    .htaccessによるアクセス制御機能を追加。同じユーザー名では登録できないよう変更。作成ディレクトリ内にindex.htmlを作るようにした。
28 ver.1.17    2010.04.19    ベーシック認証はcryptしたパスワードが使えそうなので、.htpasswdのパスワードはuser.cgiに保存されているものを使うようにする
29 ver.1.18    2010.04.21    スクリプトの設定項目のいくつかをブラウザで編集できるよう修正。
30 ver.1.19    2010.04.23    全角文字の入ったディレクトリを作成できないよう変更。古いファイルの一括削除で、.htaccessやindex.htmlも削除してしまっていたのを修正。
31 ver.1.20    2010.08.13    日本語文字コードライブラリにJcode.pmを選べるように修正。管理者画面で指定日数以上経過したファイルを一括削除する際、サブディレクトリ内のファイルが日数経過していないのに削除されるバグを修正。
32 ver.1.21    2010.08.18    バックアップファイル名を変更。
33 ver.1.22    2010.09.21    ファイルダウンロードのURLにユーザーID、パスワードを含めるのを廃止。(InternetExplorer対策)
34 ver.1.23    2010.09.24    管理者設定画面から、ユーザーに登録内容を伝えるメールを送信できるようにした。ユーザーの非暗号化パスワードも保存するようにした。
35 ver.1.3        2010.09.27    ユーザー側からも新規登録できるように変更。
36 ver.1.31    2010.09.28    ユーザーの登録・ファイルのアップロード時に、管理者にメールで通知する機能を追加。
37 ver.1.32    2010.10.04    cryptしたパスワードに/や.が入っていると、ディレクトリ作成に失敗することがあるため、作成に成功するまで、cryptを複数回行うようにした。
38                         その際、連続してsrand()を行っても同じ乱数が発生するためseedも乱数で生成するようにした。
39 ver.1.33    2010.10.05    ディレクトリを削除する際、サブディレクトリがあるとエラーが発生するのを修正。
40 ver.1.34    2010.10.06    ユーザー登録時、管理者からの新規ユーザー登録、登録内容変更の際にファイルロックするように変更。アップロードするファイルサイズに制限をかけられるようにした。
41 ver.1.35    2010.10.07    ディレクトリ内にindex.htmlを作成する設定にしていても、作成されない場合があるのを修正。index.htmlが削除された場合は自動的に生成するように修正。
42                         管理者へのメール送信先を複数指定できるように修正。cryptしたパスワードに/や.を含めないように変更。
43 ver.1.36    2010.10.12    .htaccessによるアクセス制限を行う設定で、管理者パスワードを変更した場合、ユーザーごとの.htpasswdに管理者パスワードの変更が反映されていなかったのを修正。
44 ver.1.37    2010.10.14    ユーザーが登録した場合、ベーシック認証出来ないバグを修正。
45 ver.1.38    2010.10.15    ユーザー設定を別ファイルに書き出し、バージョンアップの際にその設定ファイルから復元出来るようにした。
46 ver.1.381    2010.10.18    config.cgiの区切り文字を:から<>に変更。
47 ver.1.39    2010.10.19    config.cgiからの設定の復元で、値を0に指定していた項目が反映されていなかったのを修正。
48                         ファイルサイズの制限を超えたファイルをアップロードしようとして失敗したとき、上限サイズのファイルが残ったままになってしまうのを修正。
49 ver.1.4        2010.10.20    ユーザー登録の内容修正や登録の削除を、ユーザー側からできるように変更。
50 ver.1.41    2010.10.21    管理者モードでログイン時のみ管理者設定、ユーザーモードでログイン時のみユーザー設定へのリンクを表示するよう変更。
51 ver.1.42    2010.10.22    ユーザー登録内容が変更されたり、登録が削除されたら、メールで管理人に通知できるよう修正。
52 ver.1.43    2010.10.29    ログイン直後にユーザー専用ディレクトリ名が表示されないのを修正。
53 ver.1.44    2010.11.05    ユーザー登録時に作成されるディレクトリに.が含まれてしまうことがあるのを修正。
54 ver.1.45    2010.11.10    ユーザー登録時の最大容量制限がスクリプト設定の「デフォルトの最大容量」を反映していなかったのを修正。
55                         .htaccessファイルの操作に制限を追加。
56 ver.1.46    2010.11.12    ユーザー名の長さ制限設定($max_user_idで指定)。
57 ver.1.47    2010.11.15    アップロードファイルの自動削除機能追加。
58 ver.1.50    2010.11.26    ファイルの受け渡し相手にメールでアップロード、ダウンロードのURLを送信できるように変更。
59 ver.1.51    2011.01.26    ファイルのURLを直接指定してダウンロードする方式から、CGIでダウンロードする方式に変更。
60                         これにともなって、日本語名ファイルを日本語のままダウンロード出来るようになり、ベーシック認証のパスワード入力の必要がなくなった。
61                         ファイル受け渡し先へのメール送信フォームで、本文の修正がプレビューに反映されていなかったバグを修正。
62 ver.1.52    2011.01.27    ファイルダウンロードのURLを修正。ファイル受け渡し先へのメール送信フォームで、メールタイトルも編集可能に修正。
63                         メールを受け取ったファイル受け渡し相手は、ユーザー設定、メール送信、ディレクトリ作成、ディレクトリ移動を制限した制限ユーザーモードでログインするように修正。
64 ver.1.53    2011.01.29    ユーザーID、パスワードをクッキーに保存するかどうか選択できるように修正。ユーザー登録時に登録内容をメールで送信できるように修正。
65 ver.1.54    2011.01.31    制限ユーザーへのメール送信で、改行が増えてしまう場合があるのを修正。
66 ver.1.55    2011.02.01    保存した生パスワードに改行コードが混じっていたために、制限ユーザーのパスワード照合に失敗する場合があったのを修正。
67                         メールアドレス未登録のユーザーもURLメール送信フォームを使えるように変更。
68                         登録ユーザー自身が登録を抹消しても、生パスワードの登録が残ったままだったのを修正。
69 ver.1.56    2011.02.02    ファイルダウンロードのURLに含まれるパスワード情報を暗号化。カレントディレクトリにアクセスするゲストモードのURLを表示するように改修。
70                         ファイル名に半角空白が入っているとダウンロードに失敗するのを修正。
71 ver.1.57    2011.02.03    管理者設定画面でスクリプトの設定を変更する場合、スクリプト内の変更すべきでない行を編集してしまわないよう修正。
72                         管理者設定画面のレイアウトを若干変更。
73 ver.1.58    2011.02.04    ディレクトリ名に半角空白が使用されると、削除出来なくなるので、_(アンダーバー)に変換するよう修正。
74 ver.1.59    2011.02.07    base64変換はmimew.plで行うよう修正。config.cgiからの設定の復元に失敗する場合があるのを修正。
75 ver.1.60    2011.02.08    ロック処理を見直し。管理者設定画面でユーザーが使用していないディレクトリを一括削除出来るようにした。
76 ver.1.61    2011.02.10    パスワードに使用すると問題のある文字を使用できないように修正(#;&+など)。管理者設定画面のレイアウトを修正。
77                         ユーザーIDやパスワードに,(カンマ)を使うとエラーになるのを修正。
78 ver.1.62    2011.02.15    パスワード自動生成機能を追加。管理者画面でユーザーの表示件数を設定できるよう変更。
79 ver.1.70    2011.02.16    管理者設定画面を表示するsub adminがゴチャゴチャしてきたので、整理して全面的に書き換え。
80                         登録ユーザー検索、未使用のディレクトリの一括削除、アップロードファイルの一覧表示機能追加。
81                         メールのテンプレートを外部ファイルに移動。
82 ver.1.71    2011.02.22    パスワード自動生成ボタンを押すと、直接パスワードフォームに入力されるように変更。
83                         パスワード新規作成時や修正時はpasswordフォームではなく、textフォームを使用し、自動生成されたパスワードを目視確認できるようにした。
84                         パーミッションの変更が画面上に反映されていなかったのを修正。
85 ver.1.72    2011.03.04    ファイルのダウンロード回数をカウントできるように修正。
86                         管理者設定ユーザーはユーザー側でユーザー設定を変更できないよう修正。
87 ver.1.73    2011.03.09    ルートディレクトリ(アップロード用最上位ディレクトリ)より上のディレクトリにもアクセスできるモードを追加(管理者のみ)。
88 ver.1.74    2011.03.25    ver.1.73でディレクトリ移動や、ディレクトリ表示がおかしくなっていたのを修正。
89 ver.1.75    2011.03.29    ユーザーごとのアクセスログを記録するよう修正。
90 ver.1.76    2011.04.14    メール送信フォームにCC、BCCを表示できるように修正。アップロードしたファイル名が文字化けすることがあるのを修正。
91 ver.1.77    2011.05.11    Jcode.pmが使用できないのに文字コードライブラリでJcode.pmを指定した場合、警告を出すように修正。
92 ver.1.78    2011.05.18    管理者用ヘルプを追加。
93 ver.1.79    2011.05.27    .htaccessによるアクセス制限を行わない設定だと、生パスワードが保存されず、アップロードしたファイルがダウンロードできないバグを修正。
94 ver.1.8        2011.05.29    パスワード保存ディレクトリが作成されていない場合、自動的にディレクトリを作成する処理を追加。
95                         ユーザー設定の変更が可能なユーザーに対して、ファイルのダウンロードに失敗する場合はユーザー設定の上書きを促すメッセージを出すようにした。
96 ver.1.81    2011.05.31    .htaccessを使う設定の場合、multiuploadディレクトリにも.htaccessファイルを作成するようにした。
97                         管理者設定のユーザー一覧にパスワード関係で問題がある場合はアラームを表示するようにした。
98 ver.1.82    2011.06.08    ファイルのダウンロード処理を修正。
99 ver.1.83    2011.06.14    ファイルのアップロード処理を修正。ファイルサイズのチェックを若干早い段階で行うようにした。アップロードの処理待ち画面を表示するようにした。
100 ver.1.84    2011.06.21    ゲストモードでもディレクトリ間の移動ができるようにした。アップロード禁止拡張子を編集可能にした。
101 ver.1.85    2011.07.21    最大ダウンロード回数の設定を追加し、その回数ダウンロードしたらファイルを削除するようにした。
102 ver.1.9        2011.07.29    ゲストの認証処理を大幅に変更(メール送信時にゲスト用パスワード作成)して、有効期限が過ぎると無効になるようにした。従来のゲストは限定なしゲストに改名。
103                         専用ディレクトリのユーザー名敬称を省略。
104 ver.1.91    2011.07.29    ディレクトリ名に使用できない文字として"&"を追加。
105 ver.1.92    2011.08.01    ゲストへのメール送信フォームで表示される有効期限の日時が不正だったのを修正。
106 ver.1.93    2011.08.17    登録ユーザーのディレクトリ画面で、有効期限を過ぎたアカウントが残っているよう表示されるのを修正。
107 ver.1.931    2011.10.18    作成済みゲストアカウントアイコンでポップアップされるコメントを修正。
108 ver.1.94    2012.04.13    CGIの操作をフォームのみで行うオプションを追加。$post_only を 1 にする。
109 ver.1.941    2012.05.02    ログインフォームにリンク元など、戻り先のリンクを表示できるようにしました。$show_return を 1 にして、$return_url にURLを記述します。
110 ver.1.942    2012.06.27    アップロードしたファイルの数が多い場合、まとめてチェックできるように、メール送信フォームに「すべてチェック」ボタンを追加しました。
111 ver.1.943    2012.08.15    メール受信者への敬称を管理者設定−スクリプトの設定で変更できるようにしました。
112                         メール送信の際、ファイル直接ダウンロードURLを表示しないよう管理者設定−スクリプト設定で変更できるようにしました。
113 ver.1.95    2012.08.17    ゲストがファイルをダウンロードしたら、ユーザーにメールで知らせるオプションを追加しました。
114                         管理者設定で$send_dlmail を 1 にして、各ユーザー設定画面で「ファイルがダウンロードされたらメールで知らせる」をチェックすると有効になります。
115 ver.1.951    2012.08.24    ゲスト以外がファイルをダウンロードしても、ダウンロード通知メールが送信されてしまうバグを修正。
116                         管理者で設定した送信メールの敬称が有効になっていなかったのを修正。
117                         ユーザーモードで、ログイン直後やユーザー設定変更直後にゲストアイコンが表示されなかったのを修正。
118 ver.1.952    2012.08.27    ユーザー設定でファイルダウンロードのメール通知を無効にしていても通知メールが送信されてしまうバグを修正。
119 ver.1.96    2012.12.05    管理者IDを使用した場合のみ、管理者モードでログインするように変更。
120 ver.1.961    2012.12.11    管理者パスワードで登録ユーザーにログインできるように変更。管理者設定のユーザー管理画面から登録ユーザーIDと管理者パスワードでログインできるように修正。
121 ver.1.97    2013.03.18    期間制限なしのゲストを廃止。CGI操作をすべてフォームで行うのをデフォルト設定にする。メールで送信するログインURL、ダウンロードURLからパスワードを削除。
122 ver.1.971    2013.03.22    ログイン情報漏洩防止のため、ログイン時のみパスワード認証を行い、ログイン後の制限ページ内でのアクションは、一時パスワードファイルで認証する方式に変更。
123                         ユーザー設定画面のヘルプファイルが抜けていたのを修正。
124 ver.1.972    2013.03.28    ゲストだと、ユーザーの最大容量を超えてファイルがアップロードできるバグを修正。プロシージャ整理。perl5.12以降でjcode.plのエラーが出るのを修正。
125 ver.1.973    2013.04.11    サーバーのsendmailコマンドの-fオプションが無効だと、メールの送信元がサーバーのメールアドレスになってしまう問題に対処。
126                         ゲストへの送信メールの送信元にユーザー名を追加。
127                         ユーザーからゲストへのダウンロード先通知メールで、一度に複数のメールアドレスに送信できるように修正。
128 ver.1.974    2013.04.12    ディレクトリ名に使用できない文字として"#"、"%"を追加。そのほかの記号でディレクトリ名に使用すると削除や移動ができなくなる場合があるのを修正。(!'~=()[]-^など)
129 ver.1.975    2013.04.16    セキュリティ上の問題を修正。
130 ver.1.976    2013.04.17    管理者が作成したユーザーアカウントで、スクリプトの設定の最大ダウンロード回数が反映されていなかったのを修正。
131 ver.1.977    2014.02.12    パスワードの暗号化にDigest::MD5モジュールを使用できるように変更。
132 EOF
133 
134 #===============================================================
135 # config_start ユーザー設定【消さないでください】
136 my $title = 'マルチアップローダ';                # CGIのタイトル
137 my $simple_title = $title;
138 my $admin_name = '管理人';                        # 管理者の名前。今のところ管理者からメール送信時の名前表示にのみ使用。
139 my $admin_id = 'admin';                            # 管理者のID。ログイン時に使用。
140 my $admin_mail = '';    # 管理者のメールアドレス。複数に送信する場合は,(カンマ)で区切る。
141 my @admin_mail = split(/,/,$admin_mail);
142 my $sendmail = '/usr/lib/sendmail';                # sendmailのパス
143 my $code = 2;                                    # 暗号化方法(1:crypt 2:MD5)
144 my $adminpass = '';                # 管理者パスワード。最初のログイン時にブラウザで入力したものをcrypt化して保存するので、直接入力しないでください。
145 my $post_only = 0;                                # CGIの操作をすべてフォームで行う
146 my $user_regist = 1;                            # ユーザーからの登録を受け付ける(0=受け付けない 1=受け付ける)
147 my $free_mode = 0;                                # ルートディレクトリの制限をはずす(管理者のみ)
148 my $user_mail_neces = 0;                        # メールアドレスの登録を必須にする(0=必須にしない 1=必須にする)
149 my $chk_mail = 1;                                # メールアドレスの書式をチェックする(0=チェックしない 1=チェックする)
150 my $mail_notify = 1;                            # ユーザー登録、ファイルのアップロードを管理人にメールで通知する(0=通知しない 1=通知する)
151 my $mr = 'さん';                                # 送信相手への敬称
152 my $pass_length = 5;                            # パスワードの最低長さ
153 my $auto_pass_length = 10;                        # 自動生成されるパスワードの長さ初期値
154 my $ban = ';&#"+';                                # パスワードに使用できない文字
155 my $max_user_id = 32;                            # ユーザー名最大長さ(半角で)
156 my $make_index = 1;                                # アップロードディレクトリ内が見られないようにindex.htmlを作成する。(0=作成しない 1=作成する)
157 my $hide_index = 1;                                # アップロードディレクトリ内のindex.htmlを隠す。(0=隠さない 1=隠す)
158 my $use_htaccess = 1;                            # .htaccessによるアクセス制限を行う。(0=行わない 1=行う)
159 my $passdir = '';                    # .htaccessのパスワードファイル保存ディレクトリ。管理者パスワード入力時に自動的に生成されます。
160 my $show_cc = 0;                                # メール送信フォームにCC、BCCを追加する。
161 my $hide_file_download_url = 0;                    # メール送信の際、ファイル直接ダウンロードURLを表示しない
162 my $show_dl_count = 1;                            # ダウンロード回数をカウントする。(0=カウントしない 1=カウントする)
163 my $send_dlmail = 1;                            # ゲストがファイルをダウンロードしたときにユーザーにメールで知らせる
164 my $max_dl_count = 10;                            # 最大ダウンロード回数(この回数ダウンロードすると削除)
165 my $max_user = 20;                                # 管理者画面で一度に表示するユーザー数
166 my $save_num = 1000;                                # アクセスログ保存数
167 my $login_term = 10;                            # ログインの有効期限(分)ログイン後この時間操作がなければログインを無効にする
168 my $c_val_term = 30;                            # クッキーの有効期限(日)
169 my $title_back_col = '#0066ff';                    # タイトル背景色
170 my $title_font_size = '110%';                    # タイトルのフォント大きさ
171 my $zebra_back_col = '#eeeedd';                    # ゼブラ表示用背景色
172 my $upnmb = 8;                                    # 同時にアップロードできるファイルの数
173 my $show_process = 1;                            # 処理待ち画面を表示する。(0=表示しない 1=表示する)
174 my $show_process_time = 1;                        # アップロード所要時間を表示する。(0=表示しない 1=表示する)
175 my $upload_type = 1;                            # アップロードの処理(0=従来の方式 1=新方式)
176 my $max_file_mb = 1000;                            # アップロードするファイルサイズの制限(単位MB)
177 my $max_file_size = 1024 * 1024 * $max_file_mb;
178 my $prohibit_ext = 'cgi,pl,php,vbs,js,sh';                            # アップロード禁止の拡張子(,(カンマ)で区切る)
179 my $life = 10;                                    # アップロードファイルを一括削除するまでの日数
180 my $auto_delete = 7;                            # アップロードファイルを自動削除する日数(0=自動削除しない)
181 my $delete_log = 1;                                # 自動削除のログを記録する(0=記録しない)
182 my $max_mb = 80;                                # ユーザー専用ディレクトリのデフォルトの最大容量(MB)
183 my $encode_lib = 1;                                # 文字コードライブラリ(0=jcode.pl 1=Jcode.pm)
184 my $show_return = 0;                            # ログインフォームに戻るリンクを表示する
185 my $return_url = '';                            # ログインフォームに表示する戻り先
186 my $return_name = '';                            # 戻り先の名前
187 my $htaccess = '.htaccess';
188 my $config_file = 'config.cgi';                    # 設定保存ファイル
189 my $sample = 0;                                    # サンプルの場合、ゲストアカウントにメールアドレスを表示しない
190 # config_end ユーザー設定終了【消さないでください】
191 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',
192 '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',
193 'prohibit_ext','life','auto_delete','delete_log','max_mb','encode_lib','show_return','return_url','return_name','sample');
194 #===============================================================
195 
196 use strict;
197 use warnings;
198 no warnings qw(redefine);
199 no warnings qw(uninitialized);
200 
201 my @ver = $history =~ /ver\.?(\d+\.\d*)/g;
202 my $ver;
203 foreach my $version (@ver) {
204     $ver = $version if $version > $ver;
205 }
206 
207 use CGI qw/:standard/;
208 use File::Basename;
209 
210 my $save_log = 2;
211 my $access = './access.log';
212 my $lockdir = './lock';
213 my $lockkey = 2;
214 my $lockflag;
215 my $lock = 1;
216 my $lockfile = 'upload.lock';
217 my $cookname = 'multiupload';
218 my $access_dir = './axs';
219 my @del_list;                        # 削除したファイルのリスト
220 my $script = 'multiupload.cgi';        # スクリプトファイル名
221 
222 if (! $code) {
223     # 暗号化方法が未定の場合のみスクリプトファイルを書き換え
224     use File::Find;
225     # MD5モジュールがインストールされているかどうか調べる
226     my $md5ok;
227     find(\&mdsearch, @INC);
228     sub mdsearch {
229      if ($_ eq 'MD5.pm') {
230      $md5ok = 1;
231      return $md5ok;
232      }
233     }
234     &lock;
235     open(SCR,$script) || &error("$scriptが開けません。");
236     my @scr = <SCR>;
237     close(SCR);
238     
239     my $code_str;
240     if ($md5ok) {
241         $code_str = 'my $code = 2;' . "\t" x 9 ."# 暗号化方法(1:crypt 2:MD5)\n";
242     } else {
243         $code_str = 'my $code = 1;' . "\t" x 9 ."# 暗号化方法(1:crypt 2:MD5)\n";
244     }
245     open(SCR,">$script");
246     my $flag;
247     foreach (@scr) {
248         if (/^\s*my\s+\$code\s*=/) {
249             print SCR $code_str;
250             $flag = 1;
251         } else {
252             if (! $flag && /^\s*my\s+\$adminpass\s*=/) {
253                 print SCR $code_str;
254             }
255             print SCR $_;
256         }
257     }
258     close(SCR);
259     &unlock;
260 }
261 
262 my $debug = '';
263 my $header_flag;
264 my $error_header = 0;
265 my $updir = my $root = './upload/';
266 my $user_root2 = $root . 'root';
267 my $user_root = 'usr_root';            # ユーザーが登録するときのアップロード用ルートディレクトリ
268 $user_root = $root . $user_root;
269 my $regist_user;
270 my %mod_list;
271 my ($start_sec,$start_msec) = &get_microsec if $show_process_time;
272 my $del_day;    # ゲスト有効期限
273 my $dir_owner;    # アクセスしているディレクトリのオーナー名
274 
275 $updir =~ s/\/+$//;
276 $root =~ s/\/+$//;
277 if (! -e $root) {
278     mkdir $root;    # ルートディレクトリが存在しなければ作成
279     if ($make_index) {
280         open(INDEX,">" . join('/',$root,'index.html') );
281         close(INDEX);
282     }
283 }
284 
285 use Cwd 'realpath';
286 my $path = my $fullpath = Cwd::realpath( '.' );    # ルートディレクトリのフルパスを取得
287 my $file_nmb = 0;    # ファイルの総数
288 my $dir_nmb = 0;    # フォルダの総数
289 my @up_file_list;    # アップロードされているファイルのリスト
290 
291 my $mode = param('mode');
292 my ($prm_sec,$prm_msec) = &get_microsec if $show_process_time;    # アップロード時間を表示する場合は、ここでデータ送信時間も計測
293 my $current_dir = param('dir');
294 my $subdir = param('subdir');
295 my $show_size = param('show_size');
296 my $newdir = param('mkdir');    # 作成するディレクトリ名
297 # ディレクトリ名チェック
298 if ($newdir =~ /[^\x01-\x7E]/) {
299     &error('エラー',"ディレクトリ名に全角文字は使用しないでください。");
300 }
301 if ($newdir =~ /([\\\+;\?\*&%#\$])/) {
302     &error('エラー',"ディレクトリ名に「" . $1 . "」は使用しないでください。");
303 }
304 my $target = param('target');    # ファイル、ディレクトリの移動先
305 my $delete_file = param('delete_file');
306 my $file_path = param('file_path');
307 $file_path =~ s/ /+/g;
308 my $file = param('file');
309 my $ch_mod = param('ch_mod');
310 my $sort = param('sort');
311 my $id = param('id');
312 my $pass = param('pass');
313 my $tpass = param('tpass');
314 my $login_user = param('login_user') if param('login_user');
315 my $login_guest = param('login_guest') if param('login_guest');
316 my $login_admin = param('login_admin') if param('login_admin');
317 my @dir_list;
318 
319 # 管理者パスワードが設定されていなければ設定
320 my @config_value;
321 if (!$adminpass) {
322     &admin_pass;
323 
324 # パスワード保存ディレクトリが作成されていなければ作成
325 } elsif (! $passdir) {
326     &make_passdir;
327 }
328 my $logindir = join('/',$passdir,'login');
329 mkdir $logindir if ! -d $logindir;
330 if (! -e join('/',$logindir,'index.html')) {
331     open(INH,">" . join('/',$logindir,'index.html'));
332     close(INH);
333 }
334 
335 # 古いログインファイルを削除
336 opendir(DIR,$logindir);
337 while (my $file = readdir(DIR)) {
338     next if $file !~ /\w{10}\.cgi$/;
339     my $path = join('/',$logindir,$file);
340     if ((stat($path))[9] < time - $login_term * 60) {
341         unlink $path;    # $login_term分間操作がなければ削除
342     }
343     if ((stat($path))[10] < time - 60 * 60) {
344         unlink $path;    # ログインから1時間以上たったら削除
345     }
346     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') {
347         unlink $path;    # ログアウトしたら削除
348     }
349 }
350 closedir(DIR);
351 
352 # index.htmlを作成
353 if (! -e './index.html') {
354     open(IND,">./index.html");
355     print IND <<"EOF";
356 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
357 <html lang="ja">
358 <head>
359 <META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
360 <META HTTP-EQUIV="Refresh" CONTENT="0; URL=$script">
361 <title>ジャンプ</title>
362 </head>
363 <body>
364 自動的に移動しない場合は、<a href="$script" target="_top"><storng>ここ</strong></a>をクリックしてください。
365 </body>
366 </html>
367 EOF
368     close(IND);
369 }
370 
371 if ($use_htaccess && ! -e './.htaccess') {
372     open(HTA,">./.htaccess");
373     print HTA qq(Options -Indexes\n);
374     close(HTA);
375 }
376 # 古いアップロードファイルを削除
377 if ($auto_delete) {
378     &delete_old($root,$auto_delete);
379     if ($delete_log && @del_list) {
380         &delete_log(@del_list);
381     }
382 }
383 if ($mode eq 'history') {
384     &history;
385     exit;
386 }
387 
388 
389 
390 
391 # IDとパスワードの入力がなければログインフォームを表示
392 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')) ) {
393     &login($mode);
394     exit;
395 }
396 my ($usr_perm,$usr_max_size,$user_mode,@user);
397 if (open(USR,"./user.cgi")) {
398     @user = <USR>;
399     close(USR);
400 }
401 my (%tm, %mail, %max_day, %max_down, %dlmail);
402 my $administrator;    # 管理者としてログインした場合、管理者フラグをたてる
403 my $user_admin;        # 管理者がユーザーモードでログインした時のフラグ
404 my $login_admin_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi') if $login_admin;
405 my ($comment, $err_comment);
406 if ($login_admin || ($id eq $admin_id && &decrypt($pass,$adminpass) eq 'yes')) {
407     if ($login_admin) {
408         if (-e $login_admin_path) {
409             open(GID,$login_admin_path);
410             $id = <GID>;
411             chomp $id;
412             close(GID);
413             open(LGI,">$login_admin_path");
414             print LGI $id;
415             close(LGI);
416             $administrator = 1;
417         } else {
418             &login($mode,'再ログインしてください');
419             exit;
420         }
421     } else {
422         $administrator = 1;
423         if ($mode eq 'login') {
424             &set_cookie($id,$pass,param('save_cook'));
425             &save_accesslog() if $save_log;
426         }
427         if (length($pass) > 8 && length($adminpass) == 13) {
428             $comment .= qq(<div style="color:red">8文字以上のパスワードを使用されていますが、現在8文字目までしか有効になっていません。<br>\n);
429             $comment .= qq(9文字目以降も有効にするには、お手数ですが「管理者パスワード変更」から再度登録してください。</div>\n);
430         }
431         undef $pass;
432         $login_admin = &random_str(10);
433         my $login_file = $ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi';
434         my $login_path = join('/',$logindir,$login_file);
435         open(LGI,">$login_path");
436         print LGI $id;
437         close(LGI);
438     }
439 } else {
440     if (! -e './user.cgi') {
441         open(NEW,">./user.cgi");
442         close(NEW);
443     }
444     # ユーザーとしてログインしようとした場合
445     my ($ex_login_user, $ex_login_guest);    # ログインファイルが存在するかどうか
446     my $login_user_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_user . 'user.cgi') if $login_user;
447     my $login_guest_path = join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_guest . 'guest.cgi') if $login_guest;
448     if ($login_user && -e $login_user_path) {
449         $ex_login_user = 1;
450         open(GID,$login_user_path);
451         $id = <GID>;
452         chomp $id;
453         close(GID);
454     }
455     # パスワードを入力したか、ユーザーとしてログイン済みの場合
456     if ($pass || $ex_login_user) {
457         my $pass_ok = 0;
458         my $rtm;
459         my $coded;
460         foreach my $line (@user) {
461             my ($tm, $user, $path, $e_pass, $permit, $l_size, $mail,$max_day,$max_down,$dlmail) = split(/\,/,$line);
462             $user = &rechange($user);
463             if ($user eq $id) {
464                 if (&decrypt($pass,$adminpass) eq 'yes') {
465                      $user_admin = 1;
466                 }
467                 if (! $ex_login_user && &decrypt($pass,$e_pass) eq 'no' && ! $user_admin) {
468                     $pass_ok = -1;
469                 } else {
470                     $updir = $root = $path;
471                     $updir =~ s/\/+$//;
472                     $pass_ok = 1;
473                     $usr_perm = $permit;
474                     $usr_max_size = $l_size;
475                     $rtm = $tm;
476                     $mail{"$user"} = $mail;
477                     $tm{"$user"} = $tm;
478                     $max_day{"$user"} = $max_day;
479                     $max_down{"$user"} = $max_down;
480                     $dlmail{"$user"} = $dlmail;
481                     $user_mode = 1;
482                     $coded = $e_pass;
483                     last;
484                 }
485             }
486         }
487         if ($pass_ok == 0) {
488             &error("ログインエラー","「${id}」では登録がありません。");
489         } elsif ($pass_ok == -1) {
490             &error("ログインエラー","パスワードが違います。");
491         } elsif ($mode eq 'login') {
492             $login_user = &random_str(10);
493             my $login_file = $ENV{'REMOTE_ADDR'} . $login_user . 'user.cgi';
494             my $login_path = join('/',$logindir,$login_file);
495             open(LGI,">$login_path");
496             print LGI $id;
497             close(LGI);
498             &set_cookie($id,$pass,param('save_cook')) if ! $user_admin;
499             &save_accesslog($rtm) if $save_log && ! $user_admin;
500             if (length($pass) > 8 && length($coded) == 13) {
501                 $comment .= qq(<div style="color:red">8文字以上のパスワードを使用されていますが、現在8文字目までしか有効になっていません。<br>\n);
502                 $comment .= qq(9文字目以降も有効にするには、お手数ですが「ユーザー設定」から再度パスワードを登録してください。</div>\n);
503             }
504             undef $pass;
505         } elsif ($ex_login_user) {
506             open(LGI,">$login_user_path");
507             print LGI $id;
508             close(LGI);
509         }
510     
511     # ゲストとしてログインしようとした場合
512     } elsif ($tpass || ($login_guest && -e $login_guest_path) ) {
513         &error('エラー','無効なURLです') if ! param('time') || ! param('dir');        # そのほかの必要なパラメータがない場合、アクセス拒否
514         my $dir = param('dir');
515         $dir =~ s/^\.\///;
516         if ($login_guest && -e $login_guest_path) {
517             $ex_login_guest = 1;
518             open(GID,$login_guest_path);
519             $id = <GID>;
520             chomp $id;
521             close(GID);
522         }
523         my $rtm;
524         foreach my $line (@user) {
525             my ($tm, $user, $path, $e_pass, $permit, $l_size, $mail,$max_day,$max_down) = split(/\,/,$line);
526             $user = &rechange($user);
527             # ユーザーデータからパーミッションと、ユーザー登録時間、最大ダウンロード回数データを取得。
528             if ($user eq $id) {
529                 $usr_perm = $permit;
530                 $rtm = $tm;
531                 $max_down{"$id"} = $max_down;
532                 $usr_max_size = $l_size;
533                 last;
534             }
535         }
536         my $tpass_path = join('/',$passdir,$dir,param('time') . '.cgi');    # ゲスト承認用パスワードファイルのパス
537         if (open(PAS,"$tpass_path")) {
538             my $cnt = <PAS>;
539             close(PAS);
540             my ($crypass,$updir,$del_day) = split(/<>/,$cnt);
541             $max_day{"$id"} = $del_day;
542             if ($tpass) {
543                 if (&decrypt($tpass,$crypass) eq 'no') {
544                     &error("ログインエラー","パスワードが違います。");
545                 } elsif ($mode eq 'login') {
546                     $login_guest = &random_str(10);
547                     my $login_file = $ENV{'REMOTE_ADDR'} . $login_guest . 'guest.cgi';
548                     my $login_path = join('/',$logindir,$login_file);
549                     open(LGI,">$login_path");
550                     print LGI $id;
551                     close(LGI);
552                     undef $tpass;
553                     &save_accesslog($rtm) if $save_log;
554                 }
555             }
556             # 有効期限の過ぎたパスワードファイルは削除するが、ログイン直後に期限切れになり、あとの操作がなにもできなくなってしまうという事態を避けるために、
557             # パスワードファイルの削除は、ログインかファイルのダウンロード時のみ行う。同じ理由で削除時はログインを許可しない。
558             if ($del_day ne 'p' && ($mode eq 'login' || $mode eq 'download') && param('time') + $del_day * 3600 * 24 < time) {
559                 unlink $tpass_path;    # 保存期間を過ぎたパスワードファイルを削除
560                 &error('エラー','ログインできません。有効期限が過ぎました。');
561             }
562         } else {
563             &error('エラー','ログインできません。期限切れの可能性があります。');
564         }
565         if ($ex_login_guest) {
566             open(LGI,">$login_guest_path");
567             print LGI $id;
568             close(LGI);
569         }
570     } elsif ($login_guest && ! -e $login_guest_path) {
571         &login('','再ログインしてください');
572         exit;
573     } elsif ($login_user && ! -e $login_user_path) {
574         &login('','再ログインしてください');
575         exit;
576     }
577 }
578 #my ($comment, $err_comment);
579 if (!-d $root) {
580     mkdir $root;
581     if ($make_index) {
582         open(INDEX,">" . join('/',$root,'index.html') );
583         close(INDEX);
584     }
585     $comment .= qq(<span style="color:red">${root}ディレクトリが無かったので作成しました。</span>);
586 }
587 
588 # 管理者モードの場合
589 if ($mode eq 'admin') {
590     if (! $administrator) {
591         if ($login_admin) {
592             undef $login_admin;
593             &login($mode);
594             exit;
595         } else {
596             &error("管理者画面に入れません。",qq(管理者権限がある場合は管理者アカウントで再ログインしてください。<a href="$script?mode=admin">再ログイン</a>));
597         }
598     } else {
599         &admin;
600     }
601     exit;
602 } elsif ($mode eq 'user') {
603     &user;
604     exit;
605 } elsif ($mode eq 'download') {
606     my $file = param('file');
607     $file =~ s/ /+/g;    # +が空白になってしまうので、元に戻す
608     if (! -e join('/',param('dir'),$file)) {
609         &error('エラー',qq(ファイル") . &url_decode(${file}) . qq("は存在しません。期限切れの可能\性があります。));
610     }
611     print "Content-type: application/octet-stream\n";
612     print "Content-Disposition: attachment; filename=" . &url_decode(param('file')) . "\n\n";
613     binmode(STDOUT);
614     open(IN,join('/',param('dir'),$file)) || die;
615     binmode(IN);
616     # 少しずつ読み込んで書き出すように変更(ver.1.82)
617     while (read IN, my $buf, 4096) {
618         print $buf;
619     }
620     close(IN);
621     
622     # ダウンロードしたらメール送信
623     if ($send_dlmail && param('time')) {
624         &send_dlmail;
625     }
626     
627     # ダウンロード回数を表示するファイルの処理
628     if ($show_dl_count && $file !~ /_count$/) {
629         open(CNT,'>>' . join('/',param('dir'),$file . '_count')) || die;
630         print CNT '1';
631         close(CNT);
632         # 最大ダウンロード回数ダウンロードしたらファイルとカウントファイルを削除する
633         $max_down{"$id"} = $max_dl_count if ! $max_down{"$id"} || param('dir') =~ /$user_root2/;
634         if ((stat(join('/',param('dir'),$file . '_count')))[7] >= $max_down{"$id"}) {
635             unlink join('/',param('dir'),$file);
636             unlink join('/',param('dir'),$file . '_count');
637 #            unlink join('/',param('dir'),$file . '_' . param('time') . '_count') if param('time');
638 #        } elsif (param('time')) {
639 #            open(CNT,'>>' . join('/',param('dir'),$file . '_' . param('time') . '_count')) || die;
640 #            print CNT '1';
641 #            close(CNT);
642         }
643     }
644     exit;
645 }
646 if ($current_dir) { $updir = $current_dir; }
647 $free_mode = 0 if ! $administrator;    # 管理者でのログインでなければ$free_mode解除
648 if ($free_mode) {
649     $updir = File::Spec->rel2abs($updir);
650     $updir =~ s/\\/\//g;
651 }
652 if ($subdir eq '..') {
653     # 親ディレクトリに移動する場合はパスの最後方の/以下を削除
654     $updir =~ s/[^\/]*$//;
655 } else {
656     $updir = join('/',$updir,$subdir) if $subdir;
657 }
658 if ($subdir eq '..' && index($updir,$root) < 0 && ! $free_mode) {
659     # /以下を削除したことによって(アップロードの)ルートディレクトリより上になってしまった場合はルートディレクトリに戻す。
660     $updir = $root;
661     $subdir = '';
662 }
663 $updir =~ s/\/+$//;    # 末尾にスラッシュが付いている場合は削除
664 
665 # ディレクトリを移動したときはリダイレクトする
666 my $url_id = &url_encode($id);
667 if ($subdir) {
668     my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
669     my $jump = qq($script) . &url_param(%param);
670     if ($post_only) {
671         my $param = \%param;
672         &jump($param);
673     } else {
674         $jump =~ s/&amp;/&/g;
675         &redirect($jump);
676     }
677     exit;
678 }
679 
680 # URLの書き換えで無理矢理親ディレクトリに移動できないようにリダイレクト
681 if (! $free_mode && index($updir,$root) < 0) {
682     $updir = $root;
683     my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'show_size'=>$show_size);
684     my $jump = qq($script) . &url_param(%param);
685     if ($post_only) {
686         my $param = \%param;
687         &jump($param);
688     } else {
689         &redirect($jump);
690     }
691     exit;
692 }
693 my $del_com;
694 my @user_perm = &perm_list($usr_perm);
695 if ($mode eq 'move' && ($user_perm[0] || $administrator) && ! $tpass && ! $login_guest) {
696     &move_file;
697 }
698 if ($mode eq 'delete') {
699     if ($user_perm[1] || $administrator) {
700         &delete_file;
701     } else {
702         &error('エラー','その操作は許可されていません');
703     }
704 }
705 if ($mode eq 'permission' && ($user_perm[2] || $administrator)) {
706     if ($user_perm[2] || $administrator) {
707         &permission;
708     } else {
709         &error('エラー','その操作は許可されていません');
710     }
711 }
712 my $upfile;
713 if (param('makedir') eq 'ディレクトリ作成' && $newdir) {
714     # 半角空白は_に変換
715     $newdir =~ s/ /_/g;
716     my $new_dir_path = join('/',$updir,$newdir);
717     if (mkdir $new_dir_path) {
718         if ($make_index) {
719             open(INDEX,">" . join('/',$new_dir_path,'index.html') );
720             close(INDEX);
721         }
722         $comment .= qq(<span style="color:blue"><strong>$new_dir_path</strong>を作成しました</span><br />);
723     } else {
724         $comment .= qq(<span style="color:red"><strong>$new_dir_path</strong>を作成できませんでした</span><br />);
725     }
726 }
727 foreach (@user) {
728     my ($time,$name,$dir,$epass,$permit,$l_size,$mail,$max_day,$max_down,$dlmail) = split(/\,/);
729     $name = &rechange($name);
730     $max_day{"$name"} = $max_day if ! $login_guest;
731     $max_down{"$name"} = $max_down if ! $login_guest;
732     $dlmail{"$name"} = $dlmail;
733     my $c_dir = param('dir');
734     $c_dir = $updir if ! $c_dir;
735     my $user_root2 = $root;
736     if ($dir ne $user_root && $dir =~ /$user_root/ && $c_dir =~ /$dir/) {
737         $title .= ' (' . $name . ')専用ディレクトリ';
738         $dir_owner = $name;
739         $regist_user = 1;
740         last;
741     }
742 }
743 if ($mode eq 'send_url') {
744     &send_url;
745     exit;
746 }
747 
748 # 初ログイン時にメール送信を選択していたら、メールを送信する
749 if (param('regist_mail')) {
750     &regist_mail;
751 }
752 
753 my $dir1 = $updir;
754 my $dir2 = my $link1 = '';
755 $dir1 =~ s/(^$root)//;
756 $dir2 .= $1;
757 my %param = ('dir'=>$dir2,'login_user'=>$login_user,'sort'=>$sort,'show_size'=>$show_size);
758 while ($dir1 =~ s/(^\/?[^\/]+)//) {
759     $dir2 .= $1;
760     if (!-d $dir2) {
761         my $message = $dir2 . qq(は存在しません。);
762         my $jump = $script . &url_param(%param) . qq(&message=) . &url_encode($message);
763         $jump =~ s/&amp;/&/g;
764         &redirect($jump);
765         exit;
766     }
767     $param{'dir'} = $dir2;
768 }
769 
770 my $submit = 1;
771 $submit = 2 if param('up');
772 &header();
773 my ($mail_title, $msg, $files);
774 for (my $i=1;$i<=$upnmb;$i++) {
775     if ($upfile = param('upfile' . $i)) {
776         my ($result,$size,$sec,$msec) = &file_upload($updir,$i);    # $result(0:失敗 1:アップロード成功 2:上書きアップロード成功)
777         if ($encode_lib == 1) {
778             eval 'use Jcode;';
779             Jcode::convert(\$upfile, "euc");    # ファイル名のみ取得の際に文字化けを避けるためにいったんeucに変換。ファイル名取得後にsjisに戻す。
780         } else {
781             require 'jcode.pl';
782             &jcode::convert(\$upfile, "euc");    # ファイル名のみ取得の際に文字化けを避けるためにいったんeucに変換。ファイル名取得後にsjisに戻す。
783         }
784         $upfile =~ /([^\\\/]*)$/;
785         my $file_name = $1;        # /あるいは\以降のファイル名のみを取得
786         if ($encode_lib == 1) {
787             Jcode::convert(\$file_name, "sjis","euc");    # Jcode::convert(\$file_name, "sjis");だと変換できないようだ
788         } else {
789             &jcode::convert(\$file_name, "sjis");
790         }
791         my $size_com = &kiro_byte($size);
792         my $time_com;
793         $time_com = "(所要時間&nbsp;" . &time_format($sec,$msec) . ')' if $show_process_time;
794         if ($result == 2) {
795             $comment .= qq(<span style="color:blue"><strong>) . $file_name . qq(</strong> \($size_com\) を上書きアップロードしました。$time_com</span><br />);
796         } elsif ($result == 1) {
797             $comment .= qq(<span style="color:blue"><strong>) . $file_name . qq(</strong> \($size_com\) をアップロードしました。$time_com</span><br />);
798         } elsif (! $result) {
799             $comment .= qq(<span style="color:red"><strong>) . $file_name . qq(</strong>をアップロードできませんでした。$err_comment</span><br />);
800         }
801         last if ! $result;    # アップロードに失敗したら、ループを抜けてアップロードを中断
802         if ($result) {
803             $files .= $file_name . " ($size_com)\n";
804         }
805     }
806 }
807 if ($show_process_time && $files) {
808     $comment = qq(<span style="color:blue">データ送信&nbsp;・・・・・\() . &time_format(($prm_sec - $start_sec),($prm_msec - $start_msec)) . qq(\)</span><br />) . $comment;
809 }
810 
811 # アップロードを管理人に通知する設定の場合
812 if ($mail_notify && $files && @admin_mail) {
813     &upload_notify;
814 }
815 if ($user_perm[0] || $administrator) {
816     $submit = 1;
817     dispform();
818 }
819 if ($login_guest) {
820     $root = param('dir');
821 }
822 my $pre_size = &size_measure("$root");    # ユーザーのルートディレクトリの容量
823 print qq(<div style="margin-left:0.5em;margin-top:0.5em">\n);
824 $dir1 = $updir;
825 $dir2 = '';
826 $dir1 =~ s/(^$root)//;
827 $dir2 .= $1;
828 $param{'dir'} = $dir2;
829 $param{'tpass'} = $tpass if $tpass;
830 $param{'login_guest'} = $login_guest if $login_guest;
831 $param{'login_user'} = $login_user if $login_user;
832 $param{'login_admin'} = $login_admin if $login_admin;
833 $param{'time'} = param('time') if param('time');
834 if ($post_only) {
835     $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>);
836 } else {
837     $link1 .= qq(<a href="$script) . &url_param(%param) . qq(">$1</a>);
838 }
839 while ($dir1 =~ s/(^\/?[^\/]+)//) {
840     $dir2 .= $1;
841     $param{'dir'} = $dir2;
842     if ($1 ne '.') {
843         if ($post_only) {
844             $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>);
845         } else {
846             $link1 .= qq(<a href="$script) . &url_param(%param) . qq(">$1</a>);
847         }
848     } else {
849         $link1 .= $1;
850     }
851 }
852 if ($post_only) {
853     $link1 = qq(<table cellpadding="0" cellspacing="0" summary="リンク表\示"><tr>$link1</tr></table>);
854 }
855 $param{'dir'} = $updir;
856 my $reload_url = &url_param(%param);
857 my $reload_hidden = &hidden_param(%param);
858 print qq(<div>\n);
859 # ゲストアカウントを削除する場合
860 if (! $administrator && !$tpass && ! $login_guest && param('del_guest')) {
861     if (param('do_del')) {
862         if (unlink join('/',$passdir,param('dir'),param('del_guest') . '.cgi')) {
863             print qq(<span style="color:red">) . &presenttime(param('del_guest')) . qq(作成のアカウントを削除しました</span>&nbsp;);
864         }
865     } else {
866         my $mail;
867         if (open(PAS,join('/',$passdir,param('dir'),param('del_guest') . '.cgi'))) {
868             my $line = <PAS>;
869             close(PAS);
870             $mail = (split(/<>/,$line))[3];
871             chomp $mail;
872             $mail .= 'に送信した<br>' if $mail;
873         }
874         $mail = '' if $sample;
875         print qq(<table summary="アカウント削除"><tr><td>$mail) . &presenttime(param('del_guest')) . qq(作成のアカウントを削除しますか?</td>);
876         my %param = ('dir'=>$updir,'login_user'=>$login_user,'del_guest'=>param('del_guest'),'do_del'=>'1');
877         if ($post_only) {
878             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);
879         } else {
880             print qq(<td><a href="$script) . &url_param(%param) . qq(">削除する</a></td></tr></table>\n);
881         }
882     }
883 }
884 print qq(<table cellpadding="2" border="0" cellspacing="0" summary="リロードなど"><tr>\n);
885 if ($post_only) {
886     print qq(<td><form action="$script" method="post" style="margin:0; padding:0">$reload_hidden<table summary="リロード"><tr><td><input type="image" src="./img/reload.gif" alt="リロード" /></td><td><input type="submit" value="リロード" /></td></tr></table></form>\n);
887 } else {
888     print qq(<td><a href="$script$reload_url"><img src="./img/reload.gif" alt="リロード" border="0" /></a></td><td><a href="$script$reload_url">リロード</a>\n);
889 }
890 if ($administrator) {
891     if (! param('show_all')) {
892         $param{"show_all"} = 1;
893         print qq(&nbsp;<a href="$script) . &url_param(%param) . qq(">隠しファイルを表\示</a>);
894         $param{"show_all"} = 0;
895     } else {
896         $param{"show_all"} = 0;
897         print qq(&nbsp;<a href="$script) . &url_param(%param) . qq(">隠しファイルを表\示しない</a>);
898         $param{"show_all"} = 1;
899     }
900 }
901 my ($user_name, $user_mail);
902 foreach (keys %mail) {
903     if ($_ && $mail{"$_"}) {
904         $user_name = $_;
905         $user_mail = $mail{"$_"};
906     }
907 }
908 # ユーザーの場合、メールフォームを表示する
909 if ($login_user) {
910     my %param = ('mode'=>'send_url','dir'=>$updir,'login_user'=>$login_user);
911     my $mail = qq($script) . &url_param(%param);
912     if ($post_only) {
913         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="メール送信" /></form></td>);
914         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="メール送信" /></form>\n);
915     } else {
916         print qq(</td>\n<td><a href="$mail"><img src="./img/mail.gif" alt="メール送信" border="0" /></a></td><td><a href="$mail">メール送信</a>&nbsp;&nbsp;\n);
917     }
918     my $pass_dir = join('/',$passdir,$updir);
919     my $guest_count = 0;
920     my (@guest_list,@kigen,@mail);
921     if (opendir(DIR,$pass_dir)) {
922         while (my $file = readdir(DIR)) {
923             if ($file =~ /(\d{10})\.cgi/) {
924                 $guest_list[$guest_count] = $1;
925                 open(PAS,join('/',$pass_dir,$file));
926                 my $line = <PAS>;
927                 close(PAS);
928                 my $kikan = (split(/<>/,$line))[2];
929                 if ($kikan ne 'p') {
930                     $kigen[$guest_count] = $guest_list[$guest_count] + $kikan * 3600 * 24;
931                     if ($kigen[$guest_count] < time) {
932                         # 有効期限の過ぎたゲスト用パスワードファイルを削除する
933                         unlink join('/',$pass_dir,$file);
934                         next;
935                     }
936                 } else {
937                     $kigen[$guest_count] = 0;
938                 }
939                 $mail[$guest_count] = (split(/<>/,$line))[3];
940                 chomp $mail[$guest_count];
941                 $mail[$guest_count] .= qq(に送信) if $mail[$guest_count];
942                 $guest_count++;
943             }
944         }
945         closedir(DIR);
946     }
947     # ゲストアカウント表示
948     for (my $count=0; $count < $guest_count; $count++) {
949         my %param = ('dir'=>$updir,'login_user'=>$login_user,'del_guest'=>$guest_list[$count]);
950         my $opc = (int(($kigen[$count] - time) / ($kigen[$count] - $guest_list[$count]) * 100) / 100) + 0.1;
951         $opc = 1 if $opc > 1;
952         my $img_style = qq( style="filter:alpha\(opacity=) . int($opc * 100) . qq(\); -moz-opacity: $opc; opacity: $opc;");
953         my $del_link = &url_param(%param);
954         if (! $kigen[$count]) {
955             my $com = qq(ゲストアカウント$guest_list[$count]\n期限なし);
956             $com .= qq(\n$mail[$count]) if $mail[$count] && ! $sample;
957             if ($post_only) {
958                 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>);
959             } else {
960                 print qq(</td>\n<td><a href="$del_link" title="$com"><img border="0" src="./img/men.gif" alt="$com" /></a>);
961             }
962         } else {
963             my $com = qq(ゲストアカウント$guest_list[$count]\n) . &presenttime($kigen[$count]) . qq(まで有効);
964             $com .= qq(\n$mail[$count]) if $mail[$count] && ! $sample;
965             if ($post_only) {
966                 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>);
967             } else {
968                 print qq(</td>\n<td><a href="$del_link" title="$com"><img border="0" src="./img/men.gif" alt="$com"$img_style /></a>);
969             }
970         }
971     }
972     print qq(</td>\n<td>&nbsp;&nbsp;<a href="urlhelp.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="ヘルプ" />ヘルプ</a>);
973 }
974 print qq(</td></tr>\n);
975 print qq(</table>\n);
976 my $style= ' style="font-size:80%"';
977 if ($usr_max_size && $pre_size > $usr_max_size) {
978     $style = qq( style="font-size:80%;font-weight:bold;color:red");
979 } elsif ($usr_max_size && $pre_size / $usr_max_size > 0.8) {
980     $style = qq( style="font-size:80%;color:#dd2200");
981 }
982 
983 # ゲストでなければ
984 if (! $tpass && ! $login_guest) {
985     print qq(<table cellpadding="0" summary="ディレクトリの容量など"><tr><td>);
986     print qq(&nbsp;</td><td>);
987     if (! $show_size) {
988         $param{'show_size'} = 1;
989         if ($post_only) {
990             print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ディレクトリの容量を表\示" /></form>&nbsp;);
991         } else {
992             print qq(<a href="$script) . &url_param(%param) . qq(" title="ディレクトリ内のファイル数が多いと表\示に時間がかかる場合があります">ディレクトリの容量を表\示</a>&nbsp;);
993         }
994     } else {
995         $param{'show_size'} = 0;
996         if ($post_only) {
997             print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ディレクトリの容量を非表\示" /></form>&nbsp;);
998         } else {
999             print qq(<a href="$script) . &url_param(%param) . qq(">ディレクトリの容量を非表\示</a>&nbsp;);
1000         }
1001     }
1002     print qq(<span$style>\(現在容量) . &kiro_byte($pre_size);
1003     print qq( / 最大容量) . &kiro_byte($usr_max_size) if $usr_max_size;
1004     print qq(&nbsp;ファイル総数${file_nmb}個) if $show_size;
1005     print qq(&nbsp;ディレクトリ総数${dir_nmb}個) if $show_size && $dir_nmb;
1006     print qq(\)</span>);
1007     print qq(</td></tr></table>\n);
1008 } elsif ($tpass || $login_guest) {
1009     print qq(<span$style>\(現在容量) . &kiro_byte($pre_size);
1010     print qq( / 最大容量) . &kiro_byte($usr_max_size) if $usr_max_size;
1011     print qq(&nbsp;ファイル総数${file_nmb}個) if $show_size;
1012     print qq(&nbsp;ディレクトリ総数${dir_nmb}個) if $show_size && $dir_nmb;
1013     print qq(\)</span>);
1014 }
1015 # ルートディレクトリの制限がない場合
1016 if ($free_mode) {
1017     eval 'use File::Spec;';
1018     my $path = File::Spec->rel2abs($dir2);
1019     $path =~ s/\\/\//g;
1020     my (@link,$dir,$links,$last_dir);
1021     $dir = $last_dir = $path;
1022     while ($dir =~ s/(\/[^\/]+$)//) {
1023         my $link = qq($script?dir=$last_dir&amp;login_admin=$login_admin);
1024         $last_dir = $dir;
1025         $links = qq(<a href="$link">$1</a>) . $links;
1026     }
1027     $links = $dir . $links;
1028     print qq(<span id="path" style="font-weight:bold;">$links</span>\n);
1029 } else {
1030     print qq(<div id="path" style="font-weight:bold;">$link1</div>\n) if !$tpass && ! $login_guest;
1031 }
1032 print qq(<span style="color:red">) . param('message') . "</span>\n" if param('message');
1033 print qq(</div>\n);
1034 print $del_com;        # 削除情報表示
1035 print qq(<div style="margin:0.3em">$comment</div>\n) if $comment;    # 操作情報表示
1036 
1037 # 以下の条件の時「上のディレクトリへ」を表示する
1038 if (($updir ne $root && !$tpass && ! $login_guest) || $free_mode) {
1039     my %param = ('dir'=>$updir,'subdir'=>'..','login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1040     if ($post_only) {
1041         print qq(<form action="$script" method="post" style="margin:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/up.gif" alt="上のディレクトリへ" /></form>\n);
1042     } else {
1043         print qq(<a href="$script) . &url_param(%param) . qq(" title="上のディレクトリへ"><span style="position:relative;top:4px;"><img src="./img/up.gif" style="border-width:0" alt="上のディレクトリへ" /></span></a>\n);
1044     }
1045     if ($free_mode) {
1046         $updir = File::Spec->rel2abs($updir);
1047         $updir =~ s/\\/\//g;
1048     }
1049 }
1050 opendir(UPD,$updir);
1051 my (%pm, %size, %mod, %ind, %dir, %decode_name, %download);
1052 while (my $file = readdir(UPD)) {
1053     next if $file eq '.' || $file eq '..';
1054     my $dm;
1055     ($dm,$dm,$pm{"$file"},$dm,$dm,$dm,$dm,$size{"$file"},$dm,$mod{"$file"},$ind{"$file"},$dm) = stat(join('/',$updir,$file));
1056     $decode_name{"$file"} = &url_decode($file);
1057     # ディレクトリの場合
1058     if (-d join('/',$updir, $file)) {
1059         $dir{"$file"} = 1;
1060         $download{"$file"} = -1;
1061         $size{"$file"} = &size_measure(join('/',$updir, $file)) if $show_size;
1062     }
1063     # ダウンロードカウントファイルの場合
1064     if ($file =~ /_count$/) {
1065         my $file_ = $file;
1066         $file_ =~ s/_count$//;
1067         if (-e join('/',$updir,$file_)) {
1068             $download{"$file_"} = $size{"$file"};
1069         }
1070     } else {
1071         $download{"$file"} = -1;
1072     }
1073 }
1074 closedir(UPD);
1075 my $index = join('/',$updir,'index.html');
1076 if ($make_index && ! -f $index) {
1077     open(INDX,">$index");
1078     close(INDX);
1079 }
1080 my @file_list = ();
1081 if ($sort eq 'name') {
1082     foreach my $key (sort { $decode_name{$a} cmp $decode_name{$b} } keys %decode_name) {
1083         push(@file_list,$key);
1084     }
1085 } elsif ($sort eq 'name_u') {
1086     foreach my $key (sort { $decode_name{$b} cmp $decode_name{$a} } keys %decode_name) {
1087         push(@file_list,$key);
1088     }
1089 } elsif ($sort eq 'time' || !$sort) {
1090     foreach my $key (sort { $mod{$b} <=> $mod{$a} } keys %mod) {
1091         push(@file_list,$key);
1092     }
1093 } elsif ($sort eq 'time_u') {
1094     foreach my $key (sort { $mod{$a} <=> $mod{$b} } keys %mod) {
1095         push(@file_list,$key);
1096     }
1097 } elsif ($sort eq 'size') {
1098     foreach my $key (sort { $size{$b} <=> $size{$a} } keys %size) {
1099         push(@file_list,$key);
1100     }
1101 } elsif ($sort eq 'size_u') {
1102     foreach my $key (sort { $size{$a} <=> $size{$b} } keys %size) {
1103         push(@file_list,$key);
1104     }
1105 } elsif ($sort eq 'dl') {
1106     foreach my $key (sort { $download{$b} <=> $download{$a} } keys %download) {
1107         push(@file_list,$key);
1108     }
1109 } elsif ($sort eq 'dl_u') {
1110     foreach my $key (sort { $download{$a} <=> $download{$b} } keys %download) {
1111         push(@file_list,$key);
1112     }
1113 }
1114 
1115 print qq(<table cellpadding="2" border="0" summary="ディレクトリ内表\示">\n);
1116 my $show_file;
1117 foreach (@file_list) {
1118     if (! ($administrator && $free_mode) && ! param('show_all')) {
1119         # 表示するファイルがあるかどうか
1120         next if $_ eq $htaccess;
1121         next if $_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7];    # サイズが0のindex.htmlは表示しない。
1122         next if $_ =~ /(_count)$/;
1123     }
1124     $show_file = 1 ;
1125 }
1126 if ($show_file) {
1127     my (%sort,%order);
1128     foreach ('name','time','size','dl') {
1129         if ($sort eq $_) {
1130             $sort{"$_"} = $_ . '_u';
1131             $order{"$_"} = '(昇順)';
1132         } else {
1133             $sort{"$_"} = $_;
1134             $order{"$_"} = '(降順)';
1135         }
1136     }
1137     my %param = ('dir'=>$updir,'sort'=>$sort,'show_size'=>$show_size,);
1138     $param{"tpass"} = $tpass if $tpass;
1139     $param{"login_guest"} = $login_guest if $login_guest;
1140     $param{"login_user"} = $login_user if $login_user;
1141     $param{"login_admin"} = $login_admin if $login_admin;
1142 
1143     $param{"time"} = param('time') if param('time');
1144     $param{'sort'} = $sort{'name'};
1145     if ($post_only) {
1146         print qq(<tr>\n<th abbr="インデックスソ\ート" colspan="2"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ファイル名" title="ファイル名でソ\ート$order{'name'}" /></form></th>\n);
1147     } else {
1148         print qq(<tr>\n<th abbr="インデックスソ\ート" colspan="2"><a href="$script) . &url_param(%param) . qq(" title="ファイル名でソ\ート$order{'name'}">ファイル名</a></th>\n);
1149     }
1150     $param{'sort'} = $sort{'time'};
1151     if ($post_only) {
1152         print qq(<th abbr="インデックスソ\ート"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="更新日時" title="更新日時でソ\ート$order{'time'}" /></form></th>\n);
1153     } else {
1154         print qq(<th abbr="インデックスソ\ート"><a href="$script) . &url_param(%param) . qq(" title="更新日時でソ\ート$order{'time'}">更新日時</a></th>\n);
1155     }
1156     $param{'sort'} = $sort{'size'};
1157     if ($post_only) {
1158         print qq(<th abbr="インデックスソ\ート"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="サイズ" title="サイズでソ\ート$order{'size'}" /></form></th>\n);
1159     } else {
1160         print qq(<th abbr="インデックスソ\ート"><a href="$script) . &url_param(%param) . qq(" title="サイズでソ\ート$order{'size'}">サイズ</a></th>\n);
1161     }
1162     $param{'sort'} = $sort{'dl'};
1163     if ($post_only) {
1164         print qq(<th abbr="インデックスソ\ート"><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="DL" title="DL数でソ\ート$order{'dl'}" /></form></th>\n) if $show_dl_count;
1165     } else {
1166         print qq(<th abbr="インデックスソ\ート"><a href="$script) . &url_param(%param) . qq(" title="DL数でソ\ート$order{'dl'}">DL</a></th>) if $show_dl_count;
1167     }
1168     print qq(<th abbr="インデックス">属性</th>);
1169     print qq(<td>&nbsp;</td><td>&nbsp;</td>);
1170     print qq(</tr>\n);
1171 } else {
1172     my $colspan = 5;
1173     $colspan++ if $show_dl_count;
1174     print qq(<tr><td colspan="$colspan"><span style="color:gray">何もありません</span></td></tr>\n);
1175 }
1176 foreach (@file_list) {
1177     my $hidden_file;
1178     if (! ($administrator && $free_mode) && ! param('show_all')) {
1179         # 表示しないファイルをスキップ フリーモードの時はすべてのファイルを表示する。
1180         next if $_ eq $htaccess;
1181         next if $_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7];    # サイズが0のindex.htmlは表示しない。
1182         next if $_ =~ /_count$/;
1183     } else {
1184         if ($_ eq $htaccess || ($_ eq 'index.html' && $hide_index && !(stat(join('/',$updir,$_)))[7]) || $_ =~ /_count$/) {
1185             $hidden_file = 1;
1186         }
1187     }
1188     my ($tsec, $tmin, $thour, $tmday, $tmon, $tyear)=localtime($mod{"$_"});
1189     $tyear+=1900;
1190     $tmon++;
1191     my $size = &kiro_byte($size{"$_"});
1192     my $decode_name = &url_decode($_);
1193     my $link = $_;
1194     $link =~ s/%/%25/g;
1195     my $time_str = sprintf("%02d年%02d月%02d日%02d:%02d",$tyear,$tmon,$tmday,$thour,$tmin);
1196     my $img = &icon($link);
1197     my $perm = sprintf("%o", $pm{"$_"} % 512);
1198     my $move_link = "&nbsp;";
1199     my %param = ('dir'=>$updir,'sort'=>$sort,'show_size'=>$show_size,'file'=>$_);
1200     $param{'tpass'} = $tpass if $tpass;
1201     $param{'login_guest'} = $login_guest if $login_guest;
1202     $param{'login_user'} = $login_user if $login_user;
1203     $param{'login_admin'} = $login_admin if $login_admin;
1204     $param{'time'} = param('time') if param('time');
1205     if (!$tpass && ! $login_guest && ($user_perm[0] || $administrator)) {
1206         $param{'mode'} = 'move';
1207         if ($post_only) {
1208             $move_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="移動" /></form>\n);
1209         } else {
1210             $move_link = qq(<a href="$script) . &url_param(%param) . qq(">移動</a>);
1211         }
1212     }
1213     my $del_link = "&nbsp;";
1214     if ($user_perm[1] || $administrator) {
1215         $param{'mode'} = 'delete';
1216         if ($dir{"$_"}) {
1217             $param{'file_type'} = 'd';
1218         } else {
1219             $param{'file_type'} = 'f';
1220         }
1221         if ($post_only) {
1222             $del_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="削除" /></form>\n);
1223         } else {
1224             $del_link = qq(<a href="$script) . &url_param(%param) . qq(">削除</a>);
1225         }
1226     }
1227     if ($user_perm[2] || $administrator) {
1228         $param{'mode'} = 'permission';
1229         $param{'file_path'} = join('/',$updir,$link);
1230         if ($post_only) {
1231             $perm = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$perm" /></form>\n);
1232         } else {
1233             $perm = qq(<a href="$script) . &url_param(%param) . qq(">$perm</a>);
1234         }
1235     }
1236     if ($dir{"$_"}) {
1237         if (!$tpass && ! $login_guest) {
1238             my $size;
1239             if ($show_size) {
1240                 $size = &kiro_byte(&size_measure(join('/',$updir,$link)));
1241             } else {
1242                 $size = "&nbsp;";    
1243             }
1244             print qq(<tr>\n);
1245             my %param = ('dir'=>$updir,'subdir'=>$_,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size,'file'=>$_);
1246             if ($post_only) {
1247                 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);
1248                 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);
1249             } else {
1250                 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);
1251                 print qq(<td><a href="$script) . &url_param(%param) . qq(">$decode_name</a></td>\n);
1252             }
1253             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);
1254             print qq(<td>&nbsp;</td>) if $show_dl_count;
1255             print qq(<td style="text-align:center;"><div style="font-size:80%">$perm</div></td>\n);
1256             print qq(<td>$move_link</td>\n<td>$del_link</td>\n);
1257             print qq(</tr>\n);
1258         }
1259     } else {
1260         my $download = join('/',$updir,$link);
1261         my %param;
1262         if ($administrator) {
1263             %param = ('mode'=>'download','dir'=>$updir,'file'=>$link,'login_admin'=>$login_admin);
1264         } else {
1265             %param = ('mode'=>'download','dir'=>$updir,'file'=>$link);
1266             if ($login_guest) {
1267                 $param{'login_guest'} = $login_guest;
1268                 $param{'time'} = param('time');
1269             } elsif ($login_user) {
1270                 $param{'login_user'} = $login_user;
1271             }
1272         }
1273         my $style;
1274         if ($hidden_file) {
1275             $style = qq( style="color:#777777");
1276         }
1277         if ($post_only) {
1278             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}をダウンロード" /></form>);
1279             print qq(<tr><td align="right">$down</td>\n);
1280             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);
1281         } else {
1282             my $down = qq($script) . &url_param(%param);
1283             print qq(<tr><td align="right"><a href="$down" title="${decode_name}をダウンロード"><img src="./img/$img" alt="${decode_name}をダウンロード" style="border-width:0" /></a></td>\n);
1284             print qq(<td><a href="$down" title="${decode_name}をダウンロード"><span$style>$decode_name</span></a></td>\n);
1285         }
1286         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);
1287         if ($show_dl_count) {
1288             print qq(<td style="text-align:right;"><span style="font-size:80%">) . (stat(join('/',$updir,$_ . '_count')))[7] . qq(</span></td>\n);
1289         }
1290         print qq(<td style="text-align:center;"><span style="font-size:80%">$perm</span></td>\n);
1291         print qq(<td>$move_link</td>\n<td>$del_link</td></tr>\n);
1292     }
1293 }
1294 print qq(</table>\n</div>);
1295 my $alarm;
1296 if ($updir =~ /^$user_root/ && ! param('tpass') && ! param('login_user') && ! param('login_guest') && ! $administrator) {
1297     if (! open(RAW,join('/',$passdir,'raw_pass.cgi'))) {
1298         $alarm = 1;
1299     } else {
1300         my @raw_pass = <RAW>;
1301         close(RAW);
1302         my $rpass_ext;
1303         foreach (@raw_pass) {
1304             my ($tm, $raw_pass) = split(/\,/);
1305             my $id = param('id');
1306             if ($tm == $tm{"$id"} && $raw_pass) {
1307                 $rpass_ext = 1;
1308             }
1309         }
1310         if (! $rpass_ext) {
1311             $alarm = 1;
1312         }
1313     }
1314 }
1315 if ($alarm) {
1316     print qq(<div style="margin-top:1em;background-color:#dd2222;color:#ffffff;padding-left:0.5em">パスワード復元のお願い</div>\n);
1317     print qq(<div style="margin:1em">生パスワードが保存されていないため、ファイルのダウンロードに失敗する可能\性があります。<br />\n);
1318     print qq(復元のため、ページ右上の&nbsp;<strong>ユーザー設定</strong>&nbsp;リンクから<strong>ユーザー設定画面</strong>に移動し、<span style="color:red">何も変更せずに</span>「変更」ボタンを押してください。<br />\n);
1319     print qq(<span style="color:red">パスワードを****に変更しました。</span>と表\示されたらパスワードの復元に成功しました。<br />\n);
1320     print qq(<span style="color:red">何も変更されていません。</span>と出る場合は問題ありません。</div>);
1321 }
1322 # 生パスワードを保存できていないときだけ上記アラームを出すようにしたので、とりあえず、ver.1.8付属のhelp.htmlは削除
1323 unlink 'help.html' if -e 'help.html';
1324 # help.htmlがある場合は、その内容を表示 ルートディレクトリにいる場合だけ
1325 if ($updir eq $root && open(HTM,'help.html')) {
1326     my @html = <HTM>;
1327     close(HTM);
1328     my $start = 0;
1329     foreach (@html) {
1330         $start = 1 if index($_,'<body>') >= 0;        # <body>タグまでスキップ
1331         next if ! $start || index($_,'</body>') >= 0;
1332         next if index($_,'</html>') >= 0;
1333         print $_ if index($_,'<body>') < 0;
1334     }
1335 }
1336 &footer;
1337 exit;
1338 
1339 
1340 sub dbg {
1341     if (open(DBG,">>./debug.cgi")) {
1342         print DBG $_[0];
1343         close(DBG);
1344     }
1345 }
1346 
1347 
1348 # スクリプトの設定を復元する
1349 sub load_config {
1350     my %val;
1351     foreach (@config_value) {
1352         my ($name,$value) = split(/<>/);
1353         chomp $value;
1354         if ($name) {
1355             my $tmp = '$' . $name . '=\'' . $value . '\';';
1356             eval $tmp;
1357             $val{"$name"} = $value;
1358         }
1359     }
1360     @config_value = ();
1361     if (! open(SCR,"$script")) {
1362         &dbg(qq(${script}オープンエラー));
1363         return;
1364     }
1365     my ($chg_com, $config_start, $config_end);
1366     my @scr = <SCR>;
1367     close(SCR);
1368     my @new_scr = ();
1369     foreach my $line (@scr) {
1370         if ($line =~ /^# config_start/) { $config_start = 1; }
1371         if ($line =~ /^# config_end/) { $config_end = 1; }
1372         if ($config_end || ! $config_start) {
1373             push(@new_scr, $line);
1374             next;
1375         }
1376         foreach my $cfg ('adminpass','passdir',@config) {
1377             if ($cfg && exists $val{"$cfg"} && $line =~ /^\s*(my)?\s*\$$cfg\s*=\s*/) {
1378                 my ($value,$val);
1379                 if ($val{"$cfg"} =~ /^\d+$/) {
1380                     $value = $val{"$cfg"};
1381                 } else {
1382                     $val = $val{"$cfg"};
1383                     $val =~ s/&lt;/</g;
1384                     $val =~ s/&gt;/>/g;
1385                     $val =~ s/&quot;/"/g;
1386                     $val =~ s/\\$//;
1387                     $value = "'" . $val . "'";
1388                 }
1389                 my ($frm,$com) = split(/;/,$line);
1390                 my($var,$oval) = split(/=/,$frm);
1391                 $oval =~ s/\s//;
1392                 $oval =~ s/^['"]//;
1393                 $oval =~ s/['"]$//;
1394                 if ($oval ne $val{"$cfg"}) {
1395                     $chg_com .= qq(${frm} → ) . 'my $' . $cfg . " = " . $value . qq(\n);
1396                 }
1397                 chomp $com;
1398                 $line = 'my $' . $cfg . " = " . $value . ";" . $com . "\n";
1399                 push(@config_value,qq($cfg<>) . $val{"$cfg"} . qq(\n));
1400                 last;
1401             }
1402         }
1403         push(@new_scr, $line);
1404     }
1405 
1406     # 書き込み前にバックアップ作成
1407     open(INIT,">${script}_bck.cgi") || &error("${script}_bck.cgiが開けません。");
1408     print INIT @scr;
1409     close(INIT);
1410 
1411     open(NEW,">$script") || &error("${script}が開けません。");
1412     print NEW @new_scr;
1413     close(NEW);
1414 
1415     open(CFG,">$config_file") || &error("${config_file}が開けません。");
1416     print CFG @config_value;
1417     close(CFG);
1418     
1419     my $message = "設定を復元しました";
1420     my $jump = qq($script?message=) . &url_encode($message);
1421     &redirect($jump);
1422 }
1423 
1424 
1425 
1426 sub icon {
1427     my $file = $_[0];
1428     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');
1429     my ($tail, $img);
1430     if (-d join('/',$updir,$file)) {
1431         $img = 'dir.gif';
1432     } else {
1433         $file =~ /\.([^\.]{1,4})$/;
1434         $tail = lc $1;
1435         if ($icon{"$tail"}) {
1436             $img = $icon{"$tail"};
1437         } else {
1438             $img = 'bin.gif';
1439         }
1440     }
1441     return $img;
1442 }
1443 
1444 
1445 sub move_file {
1446     my $encode_file = &url_encode($file);
1447     $encode_file =~ s/%2e/\./g;
1448     $title .= qq( −ファイルの移動−);
1449     $encode_file =~ /\.(.{1,4})$/;
1450     my $tail = lc $1;
1451     if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1452         &error("${tail}ファイルの操作は認められていません。");
1453     }
1454     if ($file =~ /\.htaccess$/ && ! $user_perm[3] && ! $administrator) {
1455         &error(".htaccessファイルの操作は認められていません。");
1456     }
1457     my @subdir_list = ();
1458     my $subdir_com = '';
1459     if (! $target) {
1460         opendir(DIR,$updir);
1461         while(my $subdir = readdir(DIR)) {
1462             next if $subdir eq '.' || ! -d join('/',$updir,$subdir);
1463             next if $subdir eq '..' && $updir eq $root;
1464             next if $subdir eq $file;
1465             push(@subdir_list,$subdir);
1466         }
1467         closedir(DIR);
1468         if (@subdir_list) {
1469             $subdir_com .= qq(<select name="target" size=") . (scalar(@subdir_list)) . qq(" tabindex="1">\n);
1470             foreach (@subdir_list) {
1471                 my $ful_path;
1472                 if ($_ eq '..') {
1473                     $ful_path = $updir;
1474                     $ful_path =~ s/\/[^\/]*$//;
1475                 } else {
1476                     $ful_path = join('/',$updir,$_);
1477                 }
1478                 $subdir_com .= qq(<option value="$_">$ful_path</option>\n);
1479             }
1480             $subdir_com .= qq(</select>\n);
1481         }
1482         &header;
1483         print qq(<div style="margin:0.5em;">\n);
1484         my $comment;
1485         $comment = qq(<strong>) . join('/',$updir,$file) . qq(</strong>の移動先を指定してください。);
1486         $comment .= qq(<br />中のファイル、サブディレクトリもすべて移動されます。) if -d join('/',$updir,$file);
1487         print qq(<table summary="移動コメント"><tr><td valign="top"><img src="./img/) . &icon($file) . qq(" alt="$file" /></td><td align="left">$comment</td></tr></table>\n);
1488         if (@subdir_list) {
1489             my $show_size = param('show_size');
1490             my $sort = param('sort');
1491             my %param = ('mode'=>'move','move'=>'do','dir'=>$updir,'file'=>$file,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1492             if (-d join('/',$updir,$file)) {
1493                 $param{'file_type'} = 'd';
1494             } else {
1495                 $param{'file_type'} = 'f';
1496             }
1497             my $hidden = &hidden_param(%param);
1498             print <<"EOF" ;
1499 <form action="$script" method="post" style="margin:0.5em">
1500 $hidden
1501 <table summary="ディレクトリ選択">
1502 <tr><td>
1503 $subdir_com
1504 </td>
1505 <td valign="top">
1506 <input type="submit" value="移動する" tabindex="2" />
1507 <input type="submit" value="キャンセル" onclick="history.back(); return false;" tabindex="3" />
1508 </td></tr>
1509 </table>
1510 </form>
1511 EOF
1512         } else {
1513             print qq(移動先がありません。<input type="submit" value="戻る" onclick="history.back(); return false;" />\n);
1514         }
1515         print qq(</div>\n);
1516         &footer;
1517         exit;
1518     }
1519     my $original_path = join('/',$updir, $encode_file);
1520     my $target_dir = join('/',$updir, $target);
1521     if ($target eq '..') {
1522         $target_dir = $updir;
1523         $target_dir =~ s/\/[^\/]*$//;
1524     }
1525     my $target_path = join('/',$target_dir,$encode_file);
1526     
1527     use File::Copy;
1528 
1529     if (param('file_type') eq 'd') {
1530         $original_path = &url_decode($original_path);
1531     }
1532     if (param('file_type') eq 'd') {
1533         $target_path = &url_decode($target_path);
1534     }
1535     if (move $original_path, $target_path) {
1536         if (-e $original_path . '_count') {
1537             move $original_path . '_count', $target_path . '_count';
1538         }
1539         $original_path = &url_decode($original_path);
1540         $target_path = &url_decode($target_path);
1541         $del_com = qq(<div style="color:blue">${original_path}から${target_path}に移動しました。</div>);
1542     } else {
1543         $del_com = qq(<div style="color:red">${original_path}を移動できませんでした。\$original_path=$original_path \$target_path=$target_path</div>);
1544     }
1545 }
1546 
1547 
1548 sub delete_file {
1549     my $encode_file;
1550     if (param('file_type') eq 'd') {
1551         $encode_file = $file;
1552     } else {
1553         $encode_file = &url_encode($file);
1554     }
1555     $encode_file =~ s/%2e/\./g;
1556     $title .= qq( −ファイルの削除−);
1557     $encode_file =~ /\.(.{1,4})$/;
1558     my $tail = lc $1;
1559     if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1560         &error("${tail}ファイルの操作は認められていません。");
1561     }
1562     if ($file =~ /\.htaccess$/ && ! $user_perm[3] && ! $administrator) {
1563         &error(".htaccessファイルの操作は認められていません。");
1564     }
1565     if (! $delete_file) {
1566         &header;
1567         print qq(<div style="margin:0.5em;">\n);
1568         my $comment;
1569         if (-d join('/',$updir,$encode_file)) {
1570             $comment = qq(<strong>$file</strong>を削除しますか?中のファイル、サブディレクトリもすべて削除されます。);
1571         } else {
1572             $comment = qq(<strong>$file</strong>を削除しますか?);
1573         }
1574         print qq(<table summary="削除確認ボタン"><tr><td><img src="./img/) . &icon($file) . qq(" alt="$file" /></td><td>$comment</td></tr></table>\n);
1575         my $show_size = param('show_size');
1576         my $time = param('time');
1577         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);
1578         my $hidden = &hidden_param(%param);
1579         print <<"EOF";
1580 <form action="$script" method="post" style="margin:0.5em">
1581 $hidden
1582 <input type="submit" value="削除する" tabindex="1" />
1583 <input type="submit" value="キャンセル" onclick="history.back(); return false;" tabindex="2" />
1584 </form>
1585 </div>
1586 EOF
1587         &footer;
1588         exit;
1589     }
1590     my $del_path = join('/',$updir, $encode_file);
1591     if (-d $del_path) {
1592         &delete_dir($del_path);
1593         my $tmpdir = join('/',$updir, $encode_file);
1594         $tmpdir =~ s/^\.\///;
1595         $tmpdir = join('/',$passdir,$tmpdir);
1596         &delete_dir($tmpdir);    # パスワード保存ディレクトリも削除
1597         $del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>を削除しました。</div>";
1598     } elsif (-e $del_path) {
1599         if (unlink $del_path) {
1600             $del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>を削除しました。</div>";
1601         } else {
1602             $del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>を削除できませんでした。$del_path</div>";
1603         }
1604         if (-e $del_path . '_count') {
1605             unlink $del_path . '_count';
1606         }
1607     } else {
1608         $del_com = qq(<div style="color:red"><strong>) . join('/',$updir,$file) . "</strong>がありません。</div>";
1609     }
1610 }
1611 
1612 sub get_perm {
1613     $file_path = shift;
1614     my @st = stat($file_path);
1615     my (%mode);
1616     my ($mode) = $st[2] % 512;
1617     $mode{'o_r'} = $mode & 256;
1618     $mode{'o_w'} = $mode & 128;
1619     $mode{'o_x'} = $mode & 64;
1620     $mode{'g_r'} = $mode & 32;
1621     $mode{'g_w'} = $mode & 16;
1622     $mode{'g_x'} = $mode & 8;
1623     $mode{'u_r'} = $mode & 4;
1624     $mode{'u_w'} = $mode & 2;
1625     $mode{'u_x'} = $mode & 1;
1626     return %mode;
1627 }
1628 
1629 sub permission {
1630     my $chg_perm_com;
1631     my $decode_file_name = &url_decode(${file_path});
1632     $file_path =~ /\.(.{1,4})$/;
1633     my $tail = lc $1;
1634     if ($prohibit_ext =~ /$tail/ && ! $user_perm[3] && ! $administrator) {
1635         &error("${tail}ファイルの操作は認められていません。");
1636     }
1637     if ($ch_mod eq '変更') {
1638         my $chmode = 0;
1639         my ($ov,$gv,$uv);
1640         foreach ('o_r','o_w','o_x','g_r','g_w','g_x','u_r','u_w','u_x',) {
1641             my $plus = 0;
1642             if (param("$_")) {
1643                 $chmode += param("$_");
1644                 if (/r$/) {
1645                     $plus = 4;
1646                 } elsif (/w$/) {
1647                     $plus = 2;
1648                 } elsif (/x$/) {
1649                     $plus = 1;
1650                 }
1651                 if (/^o/) {
1652                     $ov += $plus;
1653                 } elsif (/^g/) {
1654                     $gv += $plus;
1655                 } elsif (/^u/) {
1656                     $uv += $plus;
1657                 }
1658             }
1659         }
1660         if (! chmod($chmode, $file_path)) {
1661             &error('パーミッション変更エラー',"${file_path}のパーミッションを変更できませんでした。\$chmode=$chmode \$file_path=$file_path");
1662         } else {
1663             my $new_prm = (stat($file_path))[2];
1664             $new_prm = substr((sprintf "%03o", $new_prm), -3);
1665             if ($new_prm == $ov . $gv . $uv) {
1666                 $chg_perm_com = qq(<span style="color:blue">${decode_file_name}のパーミッションを) . $ov . $gv . $uv . qq(に変更しました。</span>);
1667             } else {
1668                 $chg_perm_com = qq(<span style="color:red">${decode_file_name}のパーミッションを) . $ov . $gv . $uv . qq(に変更できませんでした。</span>);
1669             }
1670         }
1671     }
1672     my (%mode) = &get_perm($file_path);
1673     foreach(keys %mode){
1674         if($mode{$_}){ $mode{$_} = qq( checked="checked");}
1675         else{ $mode{$_} = "";}
1676     }
1677     my($o_v,$g_v,$u_v);
1678     foreach ('o_r','o_w','o_x','g_r','g_w','g_x','u_r','u_w','u_x',) {
1679         my $plus;
1680         if ($mode{"$_"}) {
1681             if (/r$/) {
1682                 $plus = 4;
1683             } elsif (/w$/) {
1684                 $plus = 2;
1685             } elsif (/x$/) {
1686                 $plus = 1;
1687             }
1688             if (/^o/) {
1689                 $o_v += $plus;
1690             } elsif (/^g/) {
1691                 $g_v += $plus;
1692             } elsif (/^u/) {
1693                 $u_v += $plus;
1694             }
1695         }
1696     }
1697     $title .= qq( −パーミッションの変更−);
1698     &header;
1699     print qq(<div style="margin:1em">);
1700     my %param = ('dir'=>$updir,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1701     if ($post_only) {
1702         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);
1703     } else {
1704         print qq(<div style="text-align:center;"><a href="$script) . &url_param(%param) . qq(">戻る</a></div>\n);
1705     }
1706     my $dir = param('dir');
1707     my $show_size = param('show_size');
1708     undef %param;
1709     %param = ('mode'=>'permission','dir'=>$dir,'file_path'=>$file_path,'login_user'=>$login_user,'login_admin'=>$login_admin,'sort'=>$sort,'show_size'=>$show_size);
1710     my $hidden = &hidden_param(%param);
1711     print <<"EOF";
1712 <form action="$script" method="post" style="margin:0;padding:0">
1713 $hidden
1714 <div style="text-align:center;">
1715 $chg_perm_com
1716 <div><strong>${decode_file_name}</strong>のパーミッション</div>
1717 <table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="パーミッションフォーム">
1718 <tr><th>オーナー</th><th>グループ</th><th>その他</th></tr>
1719 <tr>
1720 <td style="text-align:left;">
1721     <input type="checkbox" name="o_r" id="o_r" value="256"$mode{'o_r'} tabindex="1" /><label for="o_r">呼び出し(4)</label><br />
1722     <input type="checkbox" name="o_w" id="o_w" value="128"$mode{'o_w'} tabindex="2" /><label for="o_w">書き込み(2)</label><br />
1723     <input type="checkbox" name="o_x" id="o_x" value="64"$mode{'o_x'} tabindex="3" /><label for="o_x">実行(1)</label>
1724 </td>
1725 <td style="text-align:left;">
1726     <input type="checkbox" name="g_r" id="g_r" value="32"$mode{'g_r'} tabindex="4" /><label for="g_r">呼び出し(4)</label><br />
1727     <input type="checkbox" name="g_w" id="g_w" value="16"$mode{'g_w'} tabindex="5" /><label for="g_w">書き込み(2)</label><br />
1728     <input type="checkbox" name="g_x" id="g_x" value="8"$mode{'g_x'} tabindex="6" /><label for="g_x">実行(1)</label>
1729 </td>
1730 <td style="text-align:left;">
1731     <input type="checkbox" name="u_r" id="u_r" value="4"$mode{'u_r'} tabindex="7" /><label for="u_r">呼び出し(4)</label><br />
1732     <input type="checkbox" name="u_w" id="u_w" value="2"$mode{'u_w'} tabindex="8" /><label for="u_w">書き込み(2)</label><br />
1733     <input type="checkbox" name="u_x" id="u_x" value="1"$mode{'u_x'} tabindex="9" /><label for="u_x">実行(1)</label>
1734 </td>
1735 </tr>
1736 <tr>
1737 <td style="text-align:center;font-weight:bold">$o_v</td>
1738 <td style="text-align:center;font-weight:bold">$g_v</td>
1739 <td style="text-align:center;font-weight:bold">$u_v</td>
1740 </tr>
1741 <tr><td colspan="3" style="text-align:center;"><input type="submit" name="ch_mod" value="変更" tabindex="10" />&nbsp;<input type="submit" value="キャンセル" onclick="history.back(); return false;" /></td></tr>
1742 </table>
1743 </div>
1744 </form>
1745 </div>
1746 EOF
1747     &footer;
1748     exit;
1749 }
1750 
1751 
1752 sub perm_list {
1753     my $permit = shift;
1754     my @perm;
1755     my $count = 0;
1756     for(my $i = 1; $i <= 8; $i *= 2){
1757         if($permit & $i){ $perm[$count] = 1; }
1758         else{ $perm[$count] = 0; }
1759         $count++;
1760     }
1761     return @perm;
1762 }
1763 
1764 sub get_subdir {
1765     my $dir = shift;
1766     my @list;
1767     opendir(DIR, $dir) or return($!);
1768     while( my $file = readdir(DIR) ){
1769         next if( $file =~ /^\.{1,2}$/ );
1770         push(@list, "$dir/$file") if -d "$dir/$file";
1771     }
1772     closedir(DIR);
1773     foreach (@list) {
1774         push(@dir_list,$_);
1775         &get_subdir("$_");
1776     }
1777 }
1778 
1779 
1780 sub delete_dir {
1781     my $dir = shift;
1782     opendir(DIR, $dir) or return($!);
1783     my @subdir = ();
1784     while( my $file = readdir(DIR) ){
1785         next if( $file =~ /^\.{1,2}$/ );
1786         push(@subdir,$file);
1787     }
1788     closedir(DIR);
1789     foreach $file (@subdir) {
1790         if( -d "$dir/$file" ){ delete_dir("$dir/$file"); }
1791         else { unlink("$dir/$file") or return("$dir/$file"); }
1792     }
1793     rmdir($dir) or return($!);
1794     return 0;
1795 }
1796 
1797 # アップロードして$ife_日以上たったファイルを削除
1798 sub delete_old {
1799     my $dir = shift;
1800     my $life_ = shift;
1801     my @list = ();
1802     opendir(DIR, $dir) or die("Can not open directory:$dir ($!)");
1803     @list = readdir(DIR);
1804     closedir(DIR);
1805     foreach my $file (sort @list){
1806         next if( $file =~ /^\.{1,2}$/ );    # '.' と '..' はスキップ
1807         next if $file eq $htaccess || $file eq 'index.html';
1808         next if $_ =~ /_count$/;
1809 
1810         #-- ディレクトリの場合は自分自身を呼び出す --#
1811         if( -d "$dir/$file" ){
1812             delete_old("$dir/$file",$life_);
1813         } else {
1814             my $tm = (stat("$dir/$file"))[9];
1815             if ($tm + $life_ * 3600 * 24 < time) {
1816                 unlink("$dir/$file");
1817                 if (-e "$dir/$file" . '_count') {
1818                     unlink("$dir/$file" . '_count');
1819                 }
1820                 push(@del_list,"$dir/$file");
1821             }
1822         }
1823     }
1824 }
1825 
1826 # アップロード、ディレクトリ作成フォームを表示
1827 sub dispform {
1828     print qq(<div style="margin-left:1em;margin-top:0.4em">\n);
1829     if ($show_process) {
1830         print qq(<form action="$script" method="post" enctype="multipart/form-data" onsubmit="open_w\(\)" style="padding:0.2em">\n);
1831     } else {
1832         print qq(<form action="$script" method="post" enctype="multipart/form-data" style="padding:0.2em">\n);
1833     }
1834     print qq(<input type="hidden" name="show_size" value="1" />) if param('show_size');
1835     print qq(<input type="submit" name= "up" value="アップロード" tabindex="1" />\n);
1836     if ($tpass || $login_guest) {
1837         $del_day = $max_day{"$id"} if ! $del_day;
1838         if ($del_day ne 'p') {
1839             my $kigen = param('time') + $del_day * 3600 * 24;
1840             my $tmp = &presenttime($kigen);
1841             $tmp =~ s/:\d{2}$//;
1842             print qq(&nbsp;&nbsp;有効期限&nbsp;<strong>$tmp</strong>);
1843         }
1844     } else {
1845         chomp $max_day{"$dir_owner"};
1846         $max_day{"$dir_owner"} = $auto_delete if ! $max_day{"$dir_owner"};
1847         print qq(&nbsp;&nbsp;ファイル保存日数&nbsp;<strong>$max_day{"$dir_owner"}日</strong>);
1848     }
1849     $max_down{"$dir_owner"} = $max_dl_count if ! $max_down{"$dir_owner"};
1850     print qq(&nbsp;&nbsp;最大ダウンロード回数&nbsp;<strong>$max_down{"$dir_owner"}回</strong>) if $show_dl_count;
1851     print qq(<div>\n);
1852     for (my $i=1;$i<=$upnmb;$i++) {
1853         print qq(<input type="file" name="upfile$i" tabindex=") . ($i + 1) . qq(" style="margin-top:0.4em" />\n);
1854     }
1855     print qq(</div>\n);
1856     my $time = param('time');
1857     my $sort = param('sort');
1858     my %param = ('dir'=>$updir,'sort'=>$sort,'login_admin'=>$login_admin,'login_user'=>$login_user,'login_guest'=>$login_guest,'time'=>$time);
1859     my $hidden = &hidden_param(%param);
1860     print $hidden;
1861     print qq(</form>\n);
1862     if (! $login_guest) {
1863         print qq(<form action="$script" method="post" enctype="multipart/form-data" style="padding:0.2em">\n);
1864         print $hidden;
1865         print qq(<input type="text" name="mkdir" value="" style="ime-mode:disabled;" tabindex=") . ($upnmb + 2) . qq(" />\n);
1866         print qq(<input type="submit" name="makedir" value="ディレクトリ作成" tabindex=") . ($upnmb + 3) . qq(" />\n);
1867         print qq(</form>\n);
1868     }
1869     print qq(</div>\n);
1870 }
1871 
1872 sub file_upload {
1873     my ($upload_strt_sec,$upload_strt_msec,$upload_end_sec,$upload_end_msec);
1874     ($upload_strt_sec,$upload_strt_msec) = &get_microsec if $show_process_time;
1875 
1876     my ($updir,$nmb) = @_;
1877     $upfile =~ /\.(.{1,4})$/;
1878     my $tail = lc $1;
1879     if ($prohibit_ext =~ /$tail/ && (! $user_perm[3] || ! $login_user) && ! $administrator) {
1880         &error("${tail}ファイルの操作は認められていません。");
1881     }
1882     if ($upfile =~ /\.htaccess$/ && (! $user_perm[3] || ! $login_user) && ! $administrator) {
1883         &error(".htaccessファイルの操作は認められていません。");
1884     }
1885     my $euc_upfile = $upfile;
1886     # 表などの文字でうまくbasenameが得られないので、いったんeucに変換してからbasenameを取得し、sjisに戻す
1887     if ($encode_lib == 1) {
1888         eval 'use Jcode;';
1889         Jcode::convert(\$euc_upfile, "euc");
1890     } else {
1891         require 'jcode.pl';
1892         &jcode::convert(\$euc_upfile, "euc");
1893     }
1894 #    my $basename = basename($euc_upfile);    # web上でファイル名だけを取得できない
1895     $euc_upfile =~ /([^\\\/]+)$/;
1896     my $basename = $1;
1897     if ($encode_lib == 1) {
1898         Jcode::convert(\$basename, "sjis","euc");
1899     } else {
1900         &jcode::convert(\$basename, "sjis","euc");
1901     }
1902     $basename = &url_encode($basename);        # 日本語のファイル名でもアップロードできるようにURLエンコード
1903     $basename =~ s/%2e/\./g;                # .(ドット)も変換されてしまうので、元に戻しておく
1904     $root = param('dir') if $login_guest;
1905     my $size = &size_measure("$root");        # 専用ディレクトリの現在の総容量を計測
1906     my $write;
1907     my $filepath = join('/',$updir,$basename);    # アップロード先のファイルパス
1908     if (-e $filepath) {
1909         $write = 2;            # アップロード先に同名のファイルがあれば上書きメッセージを出すため
1910     } else {
1911         $write = 1;
1912     }
1913     my $up = 'upfile' . $nmb;
1914     my $fh = upload("$up");
1915     my $pre_size = (stat($fh))[7];
1916     
1917     if ($pre_size > $max_file_size) {
1918         $err_comment = qq(アップロードするファイルサイズの上限は${max_file_mb}MBですが、) . &kiro_byte($pre_size) . qq(あります。);
1919         return 0;
1920     } elsif ($usr_max_size && $pre_size + $size > $usr_max_size) {
1921         if ($usr_max_size - $size > 0) {
1922             $err_comment = qq(残り容量が) . &kiro_byte($usr_max_size - $size) . qq(ありますが、アップロードファイルが) . &kiro_byte($pre_size) . qq(あります。);
1923         } else {
1924             $err_comment = qq(すでにディレクトリの最大容量の) . &kiro_byte($usr_max_size) . qq(を超えています。);
1925         }
1926         return 0;
1927     }
1928     if ($upload_type == 1) {
1929         if (! copy ($fh, "$filepath")) {
1930             return 0;
1931         }
1932     } else {
1933         if (open(WF, ">$filepath")) {
1934             binmode WF;
1935             while(read($upfile, my $buf, 256)){
1936                 print WF $buf;
1937                 
1938             }
1939             close $upfile;
1940             close(WF);
1941         } else {
1942             return 0;
1943         }
1944     }
1945     ($upload_end_sec,$upload_end_msec) = &get_microsec if $show_process_time;
1946     my $sec = $upload_end_sec - $upload_strt_sec if $show_process_time;
1947     my $msec = $upload_end_msec - $upload_strt_msec if $show_process_time;
1948     if ($show_dl_count) {
1949         open(CNT,">${filepath}_count");
1950         close(CNT);
1951     }
1952     if ($show_process_time) {
1953         return ($write,$pre_size,$sec,$msec);
1954     } else {
1955         return ($write,$pre_size);
1956     }
1957 }
1958 
1959 
1960 sub header {
1961     if ($header_flag) { return; }
1962     my $nohead = $_[0];
1963     $header_flag = 1;
1964     print "Content-type: text/html\n\n";
1965     print <<"EOM";
1966 <?xml version="1.0" encoding="Shift_JIS"?>
1967 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1968 <html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja">
1969 <head>
1970 <meta http-equiv="content-type" content="text/html; charset=Shift_JIS" />
1971 <meta http-equiv="content-style-type" content="text/css" />
1972 <meta http-equiv="content-script-type" content="text/javascript" />
1973 <meta name="description" content="マルチアップローダ" />
1974 <meta name="keywords" content="キーワードを入れる" />
1975 <title>$title</title>
1976 <link rel="stylesheet" href="./style.css" type="text/css" />
1977 EOM
1978     if ($show_process && $submit) {
1979         print <<"EOM";
1980 <script type="text/javascript"><!--
1981 function open_w() {
1982     wo = window.open("","upload","toolbar=no,location=no,directories=no,menubar=no,width=300,height=50");
1983     wo.document.write("<html><head><title>アップロード中・・・</title></head>");
1984     wo.document.write("<body><div><img src='./img/uploading.gif' /></div></body></html>");
1985 }
1986 function close_w() {
1987 wo = window.open("","upload");
1988 wo.close();
1989 }
1990 //--></script>
1991 EOM
1992     }
1993     print qq(</head>\n);
1994     if ($show_process && $submit == 2) {
1995         print qq(<body onLoad="close_w()">\n);
1996     } else {
1997         print qq(<body>\n);
1998     }
1999     print &headline if $nohead ne 'nohead';
2000 }
2001 
2002 sub headline {
2003     my $html;
2004     my $text_color = &text_color($title_back_col);
2005     my $url_id = &url_encode($id);
2006     my $logout;
2007     if (! $error_header) {
2008         if ($id && ($login_user || $login_admin)) {
2009             my $param = qq(?logout=$login_user);
2010             $param = qq(?logout=$login_admin) if $login_admin;
2011             $logout = qq(<div class="home"><a href="$script$param" style="color:$text_color;text-decoration:none;">ログアウト</a>&nbsp;&nbsp;<span style="font-size:80%;color:$text_color">−${id}でログイン中−</span></div>);
2012         } elsif ($id && ($tpass || $login_guest)) {
2013             my $param = qq(?logout=$login_guest);
2014             $logout = qq(<div class="home"><a href="$script$param" style="color:$text_color;text-decoration:none;">ログアウト</a>&nbsp;&nbsp;<span style="font-size:80%;color:$text_color">−${id}\(ゲスト\)でログイン中−</span></div>);
2015         }
2016     }
2017     $html = <<"EOM";
2018 <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>
2019 $logout
2020 EOM
2021     if ($administrator || ($user_mode && $user_regist && $regist_user)) {
2022         $html .= qq(<div class="admin">);
2023         if ($administrator) {
2024             my %param = ('mode'=>'admin','login_admin'=>$login_admin);
2025             if ($post_only) {
2026                 $html .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="管理者設定" /></form>);
2027             } else {
2028                 $html .= qq(<a href="$script) . &url_param(%param) . qq(" style="color:$text_color;text-decoration:none;">管理者設定</a>\n);
2029             }
2030         } elsif ($user_mode && $user_regist && $regist_user) {
2031             my %param = ('mode'=>'user','login_user'=>$login_user);
2032             if ($post_only) {
2033                 $html .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ユーザー設定" /></form>);
2034             } else {
2035                 $html .= qq(<a href="$script) . &url_param(%param) . qq(" style="color:$text_color;text-decoration:none;">ユーザー設定</a>\n);
2036             }
2037         }
2038         $html .= qq(</div>\n);
2039     }
2040     return $html;
2041 }
2042 
2043 sub footer {
2044     print $debug;
2045     print qq(<div style="text-align:right;margin:1em">\n);
2046     print qq(<table summary="footer" style="margin-left:auto"><tr><td>$simple_title</td>\n);
2047     my %param = ('mode'=>'history','login_guest'=>$login_guest,'login_user'=>$login_user,'login_admin'=>$login_admin);
2048     if ($post_only) {
2049         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);
2050     } else {
2051         print qq(<td><a href="$script) . &url_param(%param) . qq(" title="更新履歴">ver.$ver</a></td>\n);
2052     }
2053     print qq(<td>&copy; <a href="http://shade-search.com/sts/fsw/" target="_blank">hirayama</a></td></tr></table>\n</div>);
2054     print end_html;
2055 }
2056 
2057 
2058 sub text_color {
2059     my $base_color = $_[0];
2060     my $txt_color;
2061     if ($_[0] !~ /#[a-zA-Z0-9]{6}/) {
2062         return '#000000';
2063     }
2064     $base_color =~ s/#//;
2065     my $r = substr($base_color,0,2);
2066     my $g = substr($base_color,2,2);
2067     my $b = substr($base_color,4,2);
2068     my $r_hex = hex($r);
2069     my $g_hex = hex($g);
2070     my $b_hex = hex($b);
2071     my $meido = $r_hex * 0.299 + $g_hex * 0.587 + $b_hex * 0.114;
2072     if ($meido < 128) {
2073         $txt_color = '#ffffff';
2074     } else {
2075         $txt_color = '#000000';
2076     }
2077     return $txt_color;
2078 }
2079 
2080 sub url_encode {
2081     my $encoded = $_[0];
2082     $encoded =~ s/([^\w ])/'%' . unpack('H2', $1)/eg;
2083     $encoded =~ tr/ /+/;
2084     return $encoded;
2085 }
2086 
2087 
2088 sub url_decode {
2089     my $value = $_[0];
2090     $value =~ tr/+/ /;
2091     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
2092     return $value;
2093 }
2094 
2095 sub send_dlmail {
2096     my @template;
2097     if (open(TMP,'./mail_template/dl.txt')) {
2098         @template = <TMP>;
2099         close(TMP);
2100     }
2101     open(USR,'./user.cgi');
2102     my @user = <USR>;
2103     close(USR);
2104     my ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$raw_pass,$html,$dlmail,$dm);
2105     foreach (@user) {
2106         if ((split(/\,/))[1] eq $id) {
2107             ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$dm,$dm,$dlmail) = split(/\,/);
2108             chomp $dlmail;
2109             if (! $dlmail) {
2110                 last;
2111             }
2112             $in_user = &rechange($in_user);
2113             last;
2114         }
2115     }
2116     return if ! $dlmail;
2117     my $guest_file = join('/',$passdir,param('dir'),param('time')) . '.cgi';
2118     my $mail_adr;
2119     if (open(GST,$guest_file)) {
2120         my $line = <GST>;
2121         close(GST);
2122         $mail_adr = (split(/<>/,$line))[3];
2123         chomp $mail_adr;
2124     }
2125     my @body;
2126     $mail_adr = param('time') if ! $mail_adr;
2127     my $now = &presenttime(time);
2128     my $msg;
2129     foreach (@template) {
2130         s/<time>/$now/g;
2131         s/<guest>/$mail_adr/g;
2132         s/<mr>/$mr/g;
2133         my $dir = param('dir');
2134         s/<dir>/$dir/g;
2135         my $dl_file = &url_decode(param('file'));
2136         s/<file>/$dl_file/g;
2137         push(@body,$_);
2138         $msg .= $_;
2139     }
2140 
2141     # メール用タイトル
2142     my $mail_title = qq(ファイルがダウンロードされました);
2143     # MIMEエンコード
2144     require './mimew.pl';
2145     my $send_to = &mimeencode(qq("${in_user}$mr" <$in_mail>));
2146     &mail($mail_title, $msg, $send_to, $mail_adr);
2147 }
2148 
2149 sub send_mail {
2150     my @template;
2151     if (open(TMP,'./mail_template/a2u.txt')) {
2152         @template = <TMP>;
2153         close(TMP);
2154     }
2155     open(USR,'./user.cgi');
2156     my @user = <USR>;
2157     close(USR);
2158     open(RAW,join('/',$passdir,'raw_pass.cgi'));
2159     my @raw_pass = <RAW>;
2160     close(RAW);
2161     my ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$raw_pass,$html);
2162     foreach (@user) {
2163         if ((split(/\,/))[0] == param('tm')) {
2164             ($time,$in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail) = split(/\,/);
2165             $in_user = &rechange($in_user);
2166             last;
2167         }
2168     }
2169     foreach (@raw_pass) {
2170         if ((split(/\,/))[0] == param('tm')) {
2171             $raw_pass = (split(/\,/))[1];
2172             $raw_pass = &rechange($raw_pass);
2173             last;
2174         }
2175     }
2176     if (param('send') eq 'この内容で送信') {
2177         my ($mbody,$msg,$send_to);
2178 
2179         # メール用タイトル
2180         my $mail_title = qq(${simple_title}登録のお知らせ);
2181         $msg = param('cont');
2182         $msg =~ s/&amp;/&/g;
2183         $msg =~ s/&quot;/”/g;
2184         require './mimew.pl';
2185         $send_to = &mimeencode(qq("${in_user}$mr" <$in_mail>));
2186         &mail($mail_title, $msg, $send_to, $admin_mail[0]);
2187         $html .= qq(<div style="margin:1em;text-align:center;">メールを送信しました</div>\n);
2188     # メールフォーム表示
2189     } else {
2190         my $url = url;
2191         my @body;
2192         foreach (@template) {
2193             s/<cgi_title>/$simple_title/g;
2194             s/<admin_name>/$admin_name/g;
2195             s/<user_name>/$in_user/g;
2196             s/<mr>/$mr/g;
2197             s/<url>/$url/g;
2198             s/<user_ID>/$in_user/g;
2199             s/<password>/$raw_pass/g;
2200             push(@body,$_);
2201         }
2202         my $from = $admin_mail[0];
2203         if (!$admin_mail[0]) {
2204             # 管理者メール未登録の場合は登録者のメールアドレスを送信元にする
2205             $from = $in_mail;
2206         }
2207         my $mode2 = param('mode2');
2208         my $tm = param('tm');
2209         my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>$mode2,'tm'=>$tm);
2210         $html .= qq(<div style="text-align:center;margin:1em;">\n);
2211         $html .= qq(以下の内容でメールを送信します);
2212         $html .= qq(<form action="$script" method="post">\n);
2213         $html .= &hidden_param(%param);
2214         $html .= qq(<div style="margin:1em"><table border="1" cellpadding="4" cellspacing="0" style="margin:auto;" summary="メール送信フォーム">\n);
2215         $html .= qq(<tr><td style="text-align:right;">Subject:</td><td style="text-align:left;">${simple_title}登録のお知らせ</td></tr>\n);
2216         $html .= qq(<tr><td style="text-align:right;">From:</td><td style="text-align:left;">$from</td></tr>\n);
2217         $html .= qq(<tr><td style="text-align:right;">To:</td><td style="text-align:left;">$in_mail</td></tr>\n);
2218         $html .= qq(<tr><td style="text-align:right;vertical-align:top;">本文</td><td><textarea name="cont" rows=") . (scalar(@body) + 1) . qq(" cols="80">\n);
2219         foreach (@body) {
2220             $html .= $_;
2221         }
2222         $html .= qq(</textarea></td></tr>\n);
2223         $html .= qq(<tr><td colspan="2"><div style="font-size:90%">※本文を修正する場合は、フォーム内を編集の上送信ボタンを押してください</div><input type="submit" name="send" value="この内容で送信" />&nbsp;\n);
2224         $html .= qq(<input type="submit" value="キャンセル" onclick="history.back(); return false;" /></td></tr>\n);
2225         $html .= qq(</table>\n);
2226         $html .= qq(</div>\n);
2227         $html .= qq(</form>\n);
2228         $html .= qq(</div>\n);
2229     }
2230     return $html;
2231 }
2232 
2233 
2234 sub send_url {
2235     my $name = $id;
2236     my @template;
2237     @template = &read_file('./mail_template/u2g.txt');
2238     open(USR,'./user.cgi');
2239     my @user = <USR>;
2240     close(USR);
2241     &header;
2242     if (param('nomail')) {
2243         # ゲスト用パスワードファイルを作成
2244         my $tmp = param('dir');
2245         $tmp =~ s/^\.\///;
2246         &make_dir(join('/',$passdir,$tmp)) if ! -d join('/',$passdir,$tmp);
2247         my $pass_file_path = join('/',$passdir,$tmp, param('time') . '.cgi');
2248         
2249         if (open(PAS,">$pass_file_path")) {
2250             print PAS join('<>',&encrypt(param('guest_pass')),param('dir'),param('kigen'),"\n");
2251             close(PAS);
2252         } else {
2253             &error(qq(${pass_file_path}が作成できませんでした));
2254         }
2255         my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2256         if ($post_only) {
2257             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="ディレクトリに戻る" /></form></div>\n);
2258         } else {
2259             print qq(<div style="margin:1em;text-align:center;"><a href="$script) . &url_param(%param) . qq(">ディレクトリに戻る</a></div>\n);
2260         }
2261         print qq(<div style="margin:1em;text-align:center;"><table style="margin:auto;text-align:left;"><tr><td>\n);
2262         print qq(ゲストアカウントを作成しました。\n);
2263         if (param('kigen') ne 'p') {
2264             my $kigen = &presenttime(param('time') + param('kigen') * 3600 * 24);
2265             $kigen =~ s/:\d{2}$//;
2266             print qq(<strong>${kigen}</strong>まで有効です。<br />\n);
2267         } else {
2268             print qq(有効期間は無期限です。<br />\n);
2269         }
2270         print qq(以下のURLでアクセスできます。\n);
2271         print qq(<span style="color:red">このURLは保存されませんので、必要な場合はコピーして保存してください。</span><br />\n);
2272         print qq(<span style="color:red">メールは送信されていません</span>ので、以下のURLをコピーし、メーラーなどでファイルの受け渡し相手に送ってください。<br />\n);
2273         print qq(パスワードは<strong>) . param('guest_pass') . qq(</strong>です。);
2274         print qq(</td></tr></table></div>\n);
2275         my $url = url;
2276         my $dir = param('dir');
2277         my $tpass = param('tpass');
2278         my $time = param('time');
2279         $url .= qq(?mode=login&amp;dir=$dir&amp;id=) . &url_encode($id) . qq(&amp;time=$time);    # この$idは省略するわけにはいかない
2280         if ($post_only) {
2281             print qq(<div style="margin:1em;text-align:center;">$url</div>\n);
2282         } else {
2283             print qq(<div style="margin:1em;text-align:center;"><a href="$url" target="_blank">$url</a></div>\n);
2284         }
2285         &footer;
2286         exit;
2287     }
2288     my $mail_title = qq(${simple_title}URLのお知らせ);    # メール用タイトル
2289     if (param('send') eq 'この内容で送信') {
2290         &error('メール送信エラー','送信元メールアドレスが未記入です') if ! param('sendfrom');
2291         &error('メール送信エラー','送信先メールアドレスが未記入です') if ! param('sendto');
2292         my ($mbody,$msg,$send_to,$_msg);
2293         $mail_title = param('subject') if param('subject');
2294         if ($encode_lib == 1) {
2295             eval 'use Jcode;';
2296             Jcode::convert(\$mail_title, "jis");
2297         } else {
2298             require 'jcode.pl';
2299             &jcode::convert(\$mail_title, "jis");
2300         }
2301         # ゲスト用パスワードファイルを作成
2302         my $tmp = param('dir');
2303         $tmp =~ s/^\.\///;
2304         &make_dir(join('/',$passdir,$tmp)) if ! -d join('/',$passdir,$tmp);
2305         my $pass_file_path = join('/',$passdir,$tmp, param('time') . '.cgi');
2306         
2307         if (open(PAS,">$pass_file_path")) {
2308             print PAS join('<>',&encrypt(param('guest_pass')),param('dir'),param('kigen'),param('sendto'),"\n");
2309             close(PAS);
2310         } else {
2311             &error(qq(${pass_file_path}が作成できませんでした));
2312         }
2313 
2314         # メールタイトルを定義
2315         require './mimew.pl';
2316         my $msub = &mimeencode("$mail_title");
2317 
2318         # 本文内容編集
2319         $msg = param('cont');
2320         $msg =~ s/<br>/\n/g;
2321         $msg =~ s/\r//g;
2322         $msg =~ s/<([^>]|\n)*>//g;
2323         $msg =~ s/&lt;/</g;
2324         $msg =~ s/&gt;/>/g;
2325         $msg =~ s/&amp;/&/g;
2326         $msg =~ s/&quot;/”/g;
2327         my $kigen = &presenttime(param('time') + param('kigen') * 3600 * 24);
2328         $kigen =~ s/:\d{2}$//;
2329         # 送信時に有効期限を変更した場合に備えて、有効期限日時を置換
2330         if (param('kigen') ne 'p') {
2331             $msg =~ s/(上記URLの有効期限は)\d{4}\/\d{1,2}\/\d{1,2}\(.{2}\) \d{2}:\d{2}/$1$kigen/;
2332         } else {
2333             $msg =~ s/(上記URLの有効期限は)\d{4}\/\d{1,2}\/\d{1,2}\(.{2}\) \d{2}:\d{2}.*\n//;
2334         }
2335         my $sendto = param('sendto');
2336         my @sendto_list = split(/:/,$sendto);
2337         if ( param('sendtoname') ) {
2338             $sendto_list[0] = &mimeencode(qq(") . param('sendtoname') . qq($mr" <) . param('sendto') . qq(>));
2339         }
2340         $mbody = $msg;
2341         
2342         if ($encode_lib == 1) {
2343             Jcode::convert(\$mbody, "jis");
2344         } else {
2345             &jcode::convert(\$mbody, "jis");
2346         }
2347         my $from = param('sendfrom');
2348         my $from_name = &mimeencode("$name\($simple_title\) <$from>") if $name;
2349         # sendmail送信
2350         my $count = 0;
2351         foreach $send_to (@sendto_list) {
2352             open(MAIL,"| $sendmail -f $from -t -i") || &error("メール送信失敗");
2353             print MAIL qq(From: $from_name\n) if $name;
2354             print MAIL qq(To: $send_to\n);
2355             
2356             my ($cc, $bcc);
2357             if (param('hikae')) {
2358                 $bcc .= $from;
2359             }
2360             if ($show_cc && ! $count) {
2361                 if (param('cc')) {
2362                     $cc .= param('cc');
2363                     print MAIL "CC: $cc\n";
2364                 }
2365                 if (param('bcc')) {
2366                     $bcc .= ',' . param('bcc');
2367                 }
2368             }
2369             if ($bcc && ! $count) {
2370                 print MAIL "BCC: $bcc\n";
2371             }
2372             print MAIL "Subject: $msub\n";
2373             print MAIL "MIME-Version: 1.0\n";
2374             print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
2375             print MAIL "Content-Transfer-Encoding: 7bit\n";
2376             print MAIL "X-Mailer: multiupload $ver\n\n";
2377             foreach ( split(/\n/, $mbody) ) {
2378                 if ($encode_lib == 1) {
2379                     Jcode::convert(\$_, 'jis', 'sjis');
2380                 } else {
2381                     &jcode::convert(\$_, 'jis', 'sjis');
2382                 }
2383                 print MAIL $_ . "\n";
2384             }
2385             close(MAIL);
2386             $count++;
2387         }
2388         print qq(<div style="margin:1em;text-align:center;">メールを送信しました</div>\n);
2389         my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2390         if ($post_only) {
2391             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="ディレクトリに戻る" /></form></div>\n);
2392         } else {
2393             print qq(<div style="margin:1em;text-align:center;"><a href="$script) . &url_param(%param) . qq(">ディレクトリに戻る</a></div>\n);
2394         }
2395     # プレビューの場合
2396     } else {
2397         my $url = my $cgi = url;
2398         my @body;
2399         my $name = $id;
2400         my $dir = param('dir');
2401         # 制限ユーザーにはcryptしたパスワードを送る
2402         my ($guest_pass,$crypt_pass,$time);
2403         if (! param('guest_pass')) {
2404             $guest_pass = &auto_pass(8,1,1);    # 期間限定の場合、一時パスワードを生成
2405         } else {
2406             $guest_pass = param('guest_pass');
2407         }
2408         $time = time if ! $time;
2409         $url .= qq(?mode=login&amp;dir=$dir&amp;id=) . &url_encode($id) . qq(&amp;time=$time);    # この$idは省略するわけにはいかない
2410         foreach (@template) {
2411             chomp;
2412             s/<name>/$name/g;
2413             s/<url>/$url/g;
2414             s/<pass>/$guest_pass/g;
2415             push(@body,$_);
2416         }
2417         my $from;
2418         $from = $mail{"$name"};
2419         $from = param('sendfrom') if param('sendfrom');
2420         print qq(<div style="text-align:center;margin:1em;">\n);
2421         my %param = ('dir'=>param('dir'),'login_user'=>$login_user);
2422         if ($post_only) {
2423             print qq(<div><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ディレクトリに戻る" /></form></div>\n);
2424         } else {
2425             print qq(<div><a href="$script) . &url_param(%param) . qq(">ディレクトリに戻る</a></div>\n);
2426         }
2427         print qq(<span style="position:relative;top:4px;right:1px"><img src="./img/mail.gif" alt="メール送信" /></span>ファイル受け渡しの相手先に、以下の内容でメールを送信します。);
2428         print qq(<form action="$script" method="post" style="margin:0;">\n);
2429         my $param2 = param('param2');
2430         $time = param('time') if param('time');
2431         undef %param;
2432         %param = ('mode'=>'send_url','mode2'=>$param2,'dir'=>$dir,'time'=>$time,'guest_pass'=>$guest_pass,'login_user'=>$login_user);
2433         print &hidden_param(%param);
2434         print qq(<div><table border="1" cellpadding="4" cellspacing="0" style="margin:auto;" summary="メール送信フォーム">\n);
2435         $mail_title = param('subject') if param('subject');
2436         my $size = length($mail_title) + 4;
2437         my $tab_index_count = 1;
2438         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++;
2439         my $from_com;
2440         if (! $from) {
2441             $from_com = qq(&nbsp;<span style="font-size:90%">※送信元のメールアドレスを入力してください</span><span style="color:red;font-size:80%">(必須)</span>);
2442         }
2443         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++;
2444         my $checked;
2445         if (param('hikae')) {
2446             $checked = qq( checked="checked");
2447         } else {
2448             $checked = '';
2449         }
2450         if ($from) {
2451             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へ控えメールを送信する</td></tr>\n);    $tab_index_count++;
2452         }
2453         my $sendto = param('sendto');
2454         my $sendtoname = param('sendtoname');
2455         my $sendto_size = '';
2456         if (length($sendto) > 30) {
2457             $sendto_size = qq( size=") . (length($sendto) * 1.2) . qq(");
2458         } else {
2459             $sendto_size = qq( size="30");
2460         }
2461         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" />&nbsp;<span style="font-size:90%">※送信先のメールアドレスを入力してください</span><span style="color:red;font-size:80%">(必須)</span><br />);
2462         print qq(<span style="font-size:90%">複数の宛先に送信する場合は:(コロン)で区切ってください</span></td></tr>\n);    $tab_index_count++;
2463         print qq(<tr><td style="text-align:right;">名前:</td><td style="text-align:left;"><input type="text" name="sendtoname" value="$sendtoname" size="30" tabindex="$tab_index_count" />&nbsp;<span style="font-size:90%">※送信先の名前を入力する場合</span></td></tr>\n);    $tab_index_count++;
2464         if ($show_cc) {
2465             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" />&nbsp;</td></tr>\n);    $tab_index_count++;
2466             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" />&nbsp;</td></tr>\n);    $tab_index_count++;
2467         }
2468         my (@file_list,%pm, %size, %mod, %ind, %dir, %decode_name);
2469         my @url;
2470         if (param('send') eq 'プレビュー') {
2471             my @add_str = ();
2472             my $path = url;
2473             $path =~ s/\/?$script$//;
2474             my $tmp = $dir;
2475             $tmp =~ s/^\.\///;
2476             $path = join('/',$path,$tmp);
2477             for (my $i = 1; $i <= 10; $i++) {
2478                 if (param('file' . $i)) {
2479                     my $link = my $name = param('file' . $i);
2480                     $link =~ s/%/%25/g;
2481                     my $url;
2482                     $url = &url_decode($name) . "\n" . $cgi . qq(?mode=download&amp;dir=$dir&amp;file=$link&amp;id=$url_id&amp;time=) . param('time') . qq(\n);
2483                     push(@add_str, $url);
2484                 }
2485             }
2486             @url = @add_str;
2487             if (@add_str) {
2488                 unshift(@add_str,"");
2489                 unshift(@add_str,qq(パスワードは) . $guest_pass . qq(です。));
2490                 unshift(@add_str,qq(ファイルを直接ダウンロードする場合は、以下をクリックしてください。));
2491                 unshift(@add_str,"");
2492                 chomp @add_str;
2493             }
2494             if (param('cont')) {
2495                 my $cnt = param('cont');
2496                 $cnt =~ s/\r//g;
2497                 @body = split(/\n/,$cnt);
2498             }
2499             push(@body,@add_str);
2500         } else {
2501             opendir(UPD,$dir);
2502             while (my $file = readdir(UPD)) {
2503                 next if $file eq '.' || $file eq '..' || $file eq 'index.html' || $file eq '.htaccess';
2504                 next if $file =~ /_count$/;
2505                 my $dm;
2506                 ($dm,$dm,$pm{"$file"},$dm,$dm,$dm,$dm,$size{"$file"},$dm,$mod{"$file"},$ind{"$file"},$dm) = stat(join('/',$updir,$file));
2507                 $decode_name{"$file"} = &url_decode($file);
2508                 if (-d join('/',$dir, $file)) {
2509                     $dir{"$file"} = 1;
2510                 } elsif (-f join('/',$dir, $file)) {
2511                     push(@file_list,$file)
2512                 }
2513             }
2514             closedir(UPD);
2515         }
2516         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++;
2517         if (! (param('send') ne 'プレビュー' && @file_list) ) {
2518             my $kday = param('kigen');
2519             $kday = $max_day{"$id"} if ! $kday;
2520             $kday = $auto_delete if ! $kday;
2521             my $tm = param('time');
2522             $tm = time if ! $tm;
2523             if ($kday ne 'p') {
2524                 my $kigen = &presenttime($tm + $kday * 3600 * 24);
2525                 $kigen =~ s/:\d{2}$//;
2526                 my $note = qq(\n上記URLの有効期限は${kigen}までとなっていますので、ご注意ください。);
2527                 push(@body,$note);
2528             }
2529         }
2530         if (param('chk_all')) {
2531             @body = param('cont');
2532             chomp @body;
2533         }
2534         foreach (@body) {
2535             print $_ . "\n";
2536         }
2537         print qq(</textarea></td></tr>\n);
2538          my $preview;
2539          if (! $hide_file_download_url && param('send') ne 'プレビュー') {
2540             if (@file_list) {
2541                 print qq(<tr><td colspan="2" style="text-align:left;">※ファイル直接ダウンロードのURLも送る場合は以下をチェックしてください。<input type="submit" name="chk_all" value="すべてチェック">&nbsp;<input type="submit" name="chk_all" value="すべて解除"></td></tr>\n);
2542                 $preview = 1;
2543             }
2544             my $count = 0;
2545              my $chk;
2546              if (param('chk_all') eq 'すべてチェック') {
2547                  $chk = ' checked';
2548              } elsif (param('chk_all') eq 'すべて解除') {
2549                  $chk = '';
2550              }
2551              foreach (@file_list) {
2552                  $count++;
2553                  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++;
2554              }
2555          }
2556         if ($preview) {
2557             print qq(<tr><td colspan="2"><div style="font-size:90%">※本文を修正する場合は、フォーム内を編集の上「プレビュー」ボタンを押してください</div>\n);
2558             print qq(<input type="submit" name="send" value="プレビュー" tabindex="$tab_index_count" />&nbsp;\n);    $tab_index_count++;
2559         } else {
2560             print qq(<tr><td colspan="2"><div style="font-size:90%">※本文を修正する場合は、フォーム内を編集の上「送信」ボタンを押してください</div>\n);
2561             print qq(<input type="submit" name="send" value="この内容で送信" tabindex="$tab_index_count" />&nbsp;\n);    $tab_index_count++;
2562         }
2563         print qq(<input type="submit" value="キャンセル" onclick="history.back(); return false;" tabindex="$tab_index_count" /></td></tr>\n);    $tab_index_count++;
2564         print qq(<tr><td colspan="2">アクセス有効期限\n);
2565         print qq(<select name="kigen">);
2566         my $kigen = param('kigen');
2567         chomp $kigen;
2568         chomp $max_day{"$id"};
2569         for (my $count=$auto_delete;$count>=1;$count--) {
2570             $kigen = 0 if ! $kigen;
2571             $max_day{"$id"} = 0 if ! $max_day{"$id"};
2572             if ((! $kigen && $count eq $max_day{"$id"}) || $count eq $kigen) {
2573                 print qq(<option value="$count" selected="selected">${count}日</option>);
2574             } else {
2575                 print qq(<option value="$count">${count}日</option>);
2576             }
2577         }
2578         if ($kigen eq 'p') {
2579             print qq(<option value="p" selected="selected">無期限</option>);
2580         } else {
2581             print qq(<option value="p">無期限</option>);
2582         }
2583         print qq(</select></td></tr>\n);
2584         print qq(<tr><td colspan="2"><table><tr><td style="text-align:left;font-size:80%;line-height:1.5em">このフォームでメールを送信しないと、ゲストのアカウントは作成されず、本文中のURLは有効になりません。<br />\n);
2585         print qq(別のメールソ\フトから送りたい場合は、以下の「アカウントのみ作成」ボタンを押してください。</td></tr></table>\n);
2586         print qq(<input type="submit" name="nomail" value="アカウントのみ作成" style="font-size:80%" /></td></tr>\n);
2587         print qq(</table>\n);
2588         print qq(</div>\n);
2589         print qq(</form>\n);
2590         print qq(<div style="margin:0">\n);
2591         print qq(</div>\n);
2592         print qq(</div>\n);
2593     }
2594     &footer;
2595     exit;
2596 }
2597 
2598 # 登録メール送信
2599 sub regist_mail {
2600     my ($mail_title, $msg);
2601     $mail_title = '【' . $simple_title . '】' . "$id${mr}登録";
2602     my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
2603     $year+=1900;
2604     $mon++;
2605     my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
2606     $msg = <<"EOM";
2607 ---------------------------------------------------------------
2608 <title><url>
2609 から登録完了のお知らせです
2610 ---------------------------------------------------------------
2611 <date>
2612 
2613 以下の内容で登録が完了しました。
2614 
2615 ユーザーID:<user>
2616 パスワード:<pass>
2617 専用ディレクトリ=<dir>
2618 EOM
2619     my $tmp_pass = param('pass');
2620     my $url = url;
2621     my $dir = $url . qq(?dir=$updir&id=) . &url_encode($id);
2622     $msg =~ s/<date>/$tm_com/g;
2623     $msg =~ s/<title>/$simple_title/g;
2624     $msg =~ s/<user>/$id/g;
2625     $msg =~ s/<mr>/$mr/g;
2626     $msg =~ s/<pass>/$tmp_pass/g;
2627     $msg =~ s/<url>/$url/g;
2628     $msg =~ s/<dir>/$dir/g;
2629     &mail($mail_title, $msg, $mail{"$id"}, $admin_mail[0]);
2630 }
2631 
2632 sub upload_notify {
2633     chomp $files;
2634     $mail_title = '【' . $simple_title . '】' . "ファイルアップロード";
2635     my $url = url;
2636     $url .= qq(?dir=) . param('dir');
2637     my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
2638     $year+=1900;
2639     $mon++;
2640     my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
2641     $msg = <<"EOM";
2642 ---------------------------------------------------------------
2643 <title>からファイルアップロードのお知らせです
2644 ---------------------------------------------------------------
2645 <date>
2646 
2647 <user>${mr}が
2648 <url>
2649 
2650 ---------------------------------------------------------------
2651 <files>
2652 ---------------------------------------------------------------
2653 をアップロードしました。
2654 EOM
2655     my $user = $id;
2656     $user .= '(ゲスト)' if $login_guest;
2657     $msg =~ s/<date>/$tm_com/g;
2658     $msg =~ s/<user>/$user/g;
2659     $msg =~ s/<mr>/$mr/g;
2660     $msg =~ s/<url>/$url/g;
2661     $msg =~ s/<files>/$files/g;
2662     $msg =~ s/<title>/$simple_title/g;
2663     foreach (@admin_mail) {
2664         &mail($mail_title, $msg, $_, $admin_mail[0]);
2665     }
2666 }
2667 
2668 # メール送信
2669 sub notify {
2670     my ($mail_title, $msg, $send_to) = @_;
2671     &mail($mail_title, $msg, $send_to, $admin_mail[0]);
2672 }
2673 
2674 sub mail {
2675     my ($mail_title, $msg, $send_to, $send_from) = @_;
2676     $send_from = $admin_mail[0] if ! $send_from;
2677     if ($encode_lib == 1) {
2678         eval 'use Jcode;';
2679         Jcode::convert(\$mail_title, "jis");
2680     } else {
2681         require 'jcode.pl';
2682         &jcode::convert(\$mail_title, "jis");
2683     }
2684     
2685     # メールタイトルを定義
2686     require './mimew.pl';
2687     my $msub = &mimeencode("$mail_title");
2688 
2689     # 本文内容編集
2690     $msg =~ s/<br>/\n/g;
2691     $msg =~ s/<([^>]|\n)*>//g;
2692     $msg =~ s/&lt;/</g;
2693     $msg =~ s/&gt;/>/g;
2694     
2695     # MIMEエンコード
2696     require './mimew.pl';
2697     my $mbody = $msg;
2698     if ($encode_lib == 1) {
2699         Jcode::convert(\$mbody, "jis");
2700     } else {
2701         &jcode::convert(\$mbody, "jis");
2702     }
2703     my $from_name;
2704     if (param('mode2') eq 'send_mail') {
2705         $from_name = &mimeencode("${simple_title}$admin_name <$send_from>");
2706     } else {
2707         $from_name = &mimeencode("${simple_title}自動送信 <$send_from>");
2708     }
2709     # sendmail送信
2710     open(MAIL,"| $sendmail -f $send_from -t -i") || &error("メール送信失敗");
2711     print MAIL qq(From: $from_name\n);    # -fオプションが無効になった場合に備えて
2712     print MAIL qq(To: $send_to\n);
2713     print MAIL "Subject: $msub\n";
2714     print MAIL "MIME-Version: 1.0\n";
2715     print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n";
2716     print MAIL "Content-Transfer-Encoding: 7bit\n";
2717     print MAIL "X-Mailer: multiupload $ver\n\n";
2718     foreach ( split(/\n/, $mbody) ) {
2719         if ($encode_lib == 1) {
2720             Jcode::convert(\$_, 'jis', 'sjis');
2721         } else {
2722             &jcode::convert(\$_, 'jis', 'sjis');
2723         }
2724         print MAIL $_, "\n";
2725     }
2726     close(MAIL);
2727 }
2728 
2729 sub admin {
2730     $title .= qq( −管理者設定−);
2731     my $html;
2732     my $mode2 = param('mode2');
2733     $mode2 = 'user' if ! $mode2;
2734     if ($mode2 eq 'send_mail') {
2735         $html = &send_mail;
2736     } elsif ($mode2 eq 'user') {
2737         $title .= qq( ユーザー管理);
2738         $html = &manage_user;
2739     } elsif ($mode2 eq 'config') {
2740         $title .= qq( スクリプトの設定);
2741         $html = &config('以下の設定を変更',1);
2742     } elsif ($mode2 eq 'dir_arrange') {
2743         $title .= qq( ディレクトリ管理);
2744         $html = &dir_arrange;
2745     } elsif ($mode2 eq 'file_manage') {
2746         $title .= qq( ファイル管理);
2747         $html = &file_manage;
2748     } elsif ($mode2 eq 'show_acc_log') {
2749         $title .= qq( アクセスログ);
2750         $html = &show_acc_log;
2751     } elsif ($mode2 eq 'admin_pass_chg') {
2752         $title .= qq( 管理者パスワード変更);
2753         $html = &admin_pass_chg;
2754     }
2755     &header;
2756     print qq(<div style="background-color:#eeeeee;padding:0.3em 1em 0.5em 0.5em">);
2757     my %param = ('login_admin'=>$login_admin);
2758     if ($post_only) {
2759         print qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="$rootディレクトリに戻る" /></form>);
2760     } else {
2761         print qq(<a href="$script) . &url_param(%param) . qq(">$rootディレクトリに戻る</a>);
2762     }
2763     print qq(</div>\n);
2764     print qq(<div style="padding:0.5em 1em 0 1em">\n);
2765     my ($st1,$st2,$st3,$st4,$st5,$st6);
2766     my $color = '#0000aa';
2767     $st1 = qq( style="color:blue") if $mode2 eq 'user';
2768     $st2 = qq( style="color:blue") if $mode2 eq 'config';
2769     $st3 = qq( style="color:blue") if $mode2 eq 'dir_arrange';
2770     $st4 = qq( style="color:blue") if $mode2 eq 'file_manage';
2771     $st5 = qq( style="color:blue") if $mode2 eq 'show_acc_log';
2772     $st6 = qq( style="color:blue") if $mode2 eq 'admin_pass_chg';
2773     my ($acc_log_link);
2774     if (-e $access) {
2775         my %param = ('mode'=>'admin','mode2'=>'show_acc_log','login_admin'=>$login_admin);
2776         if ($post_only) {
2777             $acc_log_link = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="アクセスログ"$st5 /></form>\n);
2778         } else {
2779             $acc_log_link = qq([<a href="$script) . &url_param(%param) . qq("$st5>アクセスログ</a>]&nbsp;\n);
2780         }
2781     }
2782     print qq(<table summary="管理者設定インデックス"><tr>);
2783     $param{'mode'} = 'admin';
2784     $param{'mode2'} = 'user';
2785     if ($post_only) {
2786         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ユーザー管理"$st1 /></form></td>\n);
2787     } else {
2788         print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st1>ユーザー管理</a>]</td>\n);
2789     }
2790     $param{'mode2'} = 'config';
2791     if ($post_only) {
2792         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="スクリプトの設定"$st2 /></form></td>\n);
2793     } else {
2794         print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st2>スクリプトの設定</a>]</td>\n\n);
2795     }
2796     $param{'mode2'} = 'dir_arrange';
2797     if ($post_only) {
2798         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ディレクトリ管理"$st3 /></form></td>\n);
2799     } else {
2800         print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st3>ディレクトリ管理</a>]</td>\n\n);
2801     }
2802     $param{'mode2'} = 'file_manage';
2803     if ($post_only) {
2804         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="ファイル管理"$st4 /></form></td>\n);
2805     } else {
2806         print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st4>ファイル管理</a>]</td>\n\n);
2807     }
2808     print qq(<td>) . $acc_log_link . qq(</td>\n);
2809     $param{'mode2'} = 'admin_pass_chg';
2810     if ($post_only) {
2811         print qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="管理者パスワード変更"$st6 /></form></td>\n);
2812     } else {
2813         print qq(<td>[<a href="$script) . &url_param(%param) . qq("$st6>管理者パスワード変更</a>]</td>\n\n);
2814     }
2815     print qq(<td><a href="adminhelp.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="ヘルプ" />ヘルプ</a></td>\n);
2816     print qq(</tr></table>\n</div>\n);
2817     if (param('comment')) {
2818         print qq(<div style="margin:1em;color:red">) . param('comment') . qq(</div>\n);
2819     }
2820     print qq(<div style="padding:0.5em 1em 1em 1em">\n);
2821     print $html;
2822     print qq(</div>\n);
2823     &footer;
2824     exit;
2825 }
2826 
2827 sub admin_pass {
2828     # 管理者パスワードが未設定でも、config.cgiやmultiupload.cgi_bck.cgiが存在すれば、その設定を引き継ぐ
2829     my ($load_config);
2830     # config.cgiが存在する場合
2831     if ($config_file && -e $config_file && open(CFG,$config_file)) {
2832         @config_value = <CFG>;
2833         close(CFG);
2834         foreach (@config_value) {
2835             my($cname,$val) = split(/<>/);
2836             chomp $val;
2837             # 設定保存ファイルに管理者パスワードが保存されていたら、設定を復元する
2838             if ($cname eq 'adminpass' && $val) {
2839                 $load_config = 1;
2840                 last;
2841             }
2842         }
2843 
2844     # config.cgiは存在しないが、バックアップファイルが存在する場合
2845     } elsif (-e "${script}_bck.cgi" && open(BCK,"${script}_bck.cgi")) {
2846         my @scr = <BCK>;
2847         close(BCK);
2848         foreach my $cfg ('adminpass','passdir',@config) {
2849             my (@tmp, $com, $name, $value,$config_start,$config_end);
2850             foreach my $line (@scr) {
2851                 if ($line =~ /^# config_start/) { $config_start = 1; }
2852                 next if ! $config_start;
2853                 if ($line =~ /^# config_end/) { $config_end = 1; }
2854                 if ($config_end) { last; }
2855                 if ($line =~ /^\s*#/) { next; }
2856                 if ($line =~ /\s*(my)?\s*\$$cfg\s*=\s*/) {
2857                     @tmp = split(/;/,$line);
2858                     $com = pop(@tmp);
2859                     chomp $com;
2860                     ($name, $value) = split(/=/,$tmp[0]);
2861                     $name =~ s/^\s*my\s*[^\$]//;
2862                     $name =~ s/\s*$//;
2863                     $value =~ s/^\s*['"]?//;
2864                     $value =~ s/['"]?\s*$//;
2865                     last;
2866                 }
2867             }
2868             push(@config_value,qq($cfg<>$value));
2869             if ($cfg eq 'adminpass' && $value) {
2870                 $load_config = 1;
2871             }
2872         }
2873     }
2874     if ($load_config) {
2875         $title .= ' −設定読み込み−';
2876         &load_config;
2877     } else {
2878         $title .= ' −初期設定−';
2879         &create_pass;
2880     }
2881     exit;
2882 }
2883 
2884 sub admin_pass_chg {
2885     my ($html, %comment);
2886     if (param('new_pass_do')) {
2887         my @init = &read_file($script);
2888         my @new_init = ();
2889         my $new_pass = param('new_pass');
2890         if ($new_pass) {
2891             my ($crypt_pass, $config_end);
2892             foreach my $line (@init) {
2893                 my $tmp = $line;
2894                 if ($line =~ /^# config_end/) { $config_end = 1; }
2895                 $tmp =~ s/ //g;
2896                 if (! $config_end && $tmp =~ /^(my)?\s*\$adminpass\s*='/) {
2897                     # 入力された管理者用パスワードをcryptして$passに代入する文字列を生成
2898                     if (length($new_pass) < $pass_length) {
2899                         &error('パスワードエラー',"パスワードは${pass_length}文字以上にしてください");
2900                     }
2901                     $crypt_pass = &encrypt($new_pass);
2902                     my @tmp = split(/;/,$line);
2903                     my $com = pop(@tmp);
2904                     my $new_pass = 'my $adminpass = ' . qq(') . $crypt_pass . qq(';) . $com;
2905                     push(@new_init,$new_pass);
2906                 } else {
2907                     push(@new_init,$line);
2908                 }
2909             }
2910             # $script書き込み前にバックアップ作成 renameだと$scriptの属性が変わってしまうのでダメ
2911             open(INIT,">${script}_bck.cgi") || &error("${script}_bck.cgiが開けません。");
2912             print INIT @init;
2913             close(INIT);
2914             
2915             # $script書き込み
2916             open(INIT,">$script") || &error("${script}が開けません。");
2917             print INIT @new_init;
2918             close(INIT);
2919             $comment{'chg_pass'} .= qq(<span style="color:blue">パスワードを変更しました。</span>);
2920             $pass = $new_pass;
2921             
2922             if ($use_htaccess) {
2923             # .htpasswd内の管理者パスワードも修正
2924                 @dir_list = ();
2925                 &get_subdir($passdir);
2926                 foreach my $path (@dir_list) {
2927                     opendir(SUB,$path);
2928                     while(my $file = readdir(SUB)) {
2929                         if ($file eq '.htpasswd') {
2930                             my $pass_path = join('/',$path,$file);
2931                             my @htpass = &read_file($pass_path);
2932                             foreach (@htpass) {
2933                                 my($name,$pass) = split(/:/);
2934                                 if ($name eq $admin_id) {
2935                                     $_ = qq($name:$crypt_pass\n);
2936                                 }
2937                             }
2938                             open(PAS,">$pass_path");
2939                             print PAS @htpass;
2940                             close(PAS);
2941                         }
2942                     }
2943                     closedir(SUB);
2944                 }
2945             }
2946         } else {
2947             $comment{'chg_pass'} .= qq(<span style="color:red">パスワードが入力されていません。</span>);
2948         }
2949     }
2950     $html .= $comment{'chg_pass'};
2951     $html .= qq(<form action="$script" method="post" style="padding:0">\n);
2952     $html .= qq(<input type="hidden" name="mode" value="admin" />\n);
2953     $html .= qq(<input type="hidden" name="mode2" value="admin_pass_chg" />\n);
2954     $html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
2955     $html .= qq(<table cellpadding="0" summary="パスワードフォーム">\n);
2956     $html .= qq(<tr><td colspan="2">管理者のユーザー名&nbsp;:&nbsp;<span style="font-size:120%">$admin_id</span></td></tr>\n);
2957     $html .= qq(<tr><td>新しいパスワード</td><td><a name="anchor" id="anchor"><input type="password" name="new_pass" value="" style="margin:0.3em" tabindex="1" /></a>&nbsp;);
2958     $html .= qq(<a name="pass_chg" id="pass_chg"><input type="submit" name="new_pass_do" value="変更する" style="margin:0.3em" tabindex="2" /></a></td></tr>\n);
2959     $html .= qq(</table>\n);
2960     $html .= qq(</form>\n);
2961     return $html;
2962 }
2963 
2964 
2965 
2966 sub manage_user {
2967     my $in_user = param('in_user');
2968     my ($comment,$send_mail_link);
2969     if (param('show_pass') && param('tm')) {
2970         my ($html, $user, $rpass);
2971         my $tm = param('tm');
2972         foreach (@user) {
2973             my ($t,$usr) = split(/\,/);
2974             if ($t == $tm) {
2975                 $user = $usr;
2976                 last;
2977             }
2978         }
2979         open(RAW,join('/',$passdir,'raw_pass.cgi'));
2980         my @raw_pass = <RAW>;
2981         close(RAW);
2982         foreach (@raw_pass) {
2983             my ($t,$rp) = split(/\,/);
2984             if ($tm == $t) {
2985                 $rpass = $rp;
2986                 $rpass = &rechange($rpass);
2987             }
2988         }
2989         $html .= qq(<strong>$user</strong>${mr}のパスワード&nbsp;:&nbsp;$rpass);
2990         return $html;
2991     } elsif($in_user && (param('new_user') || param('modify') || param('del'))) {
2992         if ($in_user eq $admin_id) { &error('エラー',"ユーザー名に${admin_id}は使用できません。"); }
2993         if (length($in_user) > $max_user_id) { &error('ユーザー名エラー',"ユーザー名は半角で${max_user_id}文字、全角で" . (int($max_user_id / 2)) . '文字以内にしてください。'); }
2994         if ($use_htaccess && $in_user =~ /:/) { &error('ユーザー名エラー','ユーザー名に:(コロン)は使わないでください。'); }
2995         &lock();
2996         my (@user, @raw_pass);
2997         @user = &read_file("./user.cgi");
2998         @raw_pass = &read_file(join('/',$passdir,'raw_pass.cgi'));
2999         my $in_path = my $tmp_path = param('in_path');
3000         $tmp_path =~ s/^\.\///;        # 頭に./がついていたら削除
3001         $in_path =~ s/\/$//;        # 末尾に/がついていたら削除
3002         my $index = join('/',$passdir,'index.html');
3003         if (! -f $index) {
3004             open(INDX,">$index");
3005             close(INDX);
3006         }
3007         my $pass_file_path = join('/',$passdir,$tmp_path,'.htpasswd');    # パスワードファイルのパス
3008         my @new_user = ();
3009         my $new_data = 1;        # 登録を削除する場合、0にする
3010         my $in_tm = param('in_tm');
3011         my $in_permit = param('upload') + param('delete') * 2 + param('permission') * 4 + param('cgi') * 8;
3012         my $in_pass = param('in_pass');
3013         my $dir_flag = 0;        # ディレクトリを作成した場合、1にする
3014         my $raw_pass = $in_pass;        # 非暗号化パスワード
3015         $in_pass = &encrypt($in_pass) if $in_pass;
3016         my $in_size = param('in_size') * 1024 * 1024;
3017         my $in_mail = param('in_mail');
3018         
3019         # 新規登録の場合、すでに使用されている名前でないかチェック
3020         if (! $in_tm) {
3021             foreach (@user) {
3022                 my ($tm, $user, $path, $pass, $permit, $l_size) = split(/\,/);
3023                 $user = &rechange($user);
3024                 if ($user eq $in_user) { &error('エラー', "${in_user}はすでに使用されています。他の名前にしてください。"); }
3025             }
3026         }
3027         if (param('in_pass') && length(param('in_pass')) < $pass_length) { &error('エラー',"パスワードは${pass_length}文字以上にしてください"); }
3028         if (!$in_permit) { &error('エラー',"許可する操作を指定してください。"); }
3029         if ($user_mail_neces && !$in_mail && ! param('del')) { &error('エラー',"メールアドレスが未記入です。"); }
3030         if ($chk_mail) {
3031             require './email_chk.pl';
3032             if ($in_mail && ! &email_chk($in_mail) && ! param('del')) { &error('エラー',"メールアドレスの書式が正しくありません。"); }
3033         }
3034         if (!$in_path) { &error('エラー',"ディレクトリを指定してください。");
3035         } elsif ($in_path ne $root && index($in_path, $root . '/') != 0) {        # ディレクトリ名に問題がある場合
3036             if (index($in_path, $root) == 0) {
3037                 &error("ディレクトリ作成エラー","${in_path}は作成できません。ディレクトリ名の間は/で区切ってください");
3038             } else {
3039                 &error("ディレクトリ作成エラー","${in_path}は作成できません。ディレクトリは${root}の下位ディレクトリにしてください。");
3040             }
3041         } elsif (!-d $in_path) {
3042             &make_dir($in_path);
3043             $dir_flag = 1;
3044         }
3045         
3046         # $in_path内に.htaccess作成。パスワードファイルのパスは join('/',$passdir,$in_path,'.htpasswd')
3047         # 続いてパスワードファイル作成。パスは join('/',$passdir,$in_path,'.htpasswd')
3048         # この.htpasswdに書くIDとパスワードは、ここで登録したユーザーだけでなく、$in_pathの上位ディレクトリがルートのユーザー全て
3049         # @userから$pathを取り出し、$in_pathの上位ディレクトリであるユーザーをピックアップ。書式は $in_path =~ /^$path/
3050         my (@parent_user_list,@child_user_list,%path,%pass);
3051         if ($use_htaccess) {
3052             my $pass_file_dir = $pass_file_path;
3053             $pass_file_dir =~ s/\/\.htpasswd//;
3054             &make_dir($pass_file_dir) if ! -d $pass_file_dir;    # パスワードファイルを置くディレクトリが存在しなければ作成
3055             my $file_path = qq($fullpath/$pass_file_path);
3056             my $hta_str = <<"EOF";
3057 AuthType Basic
3058 AuthName "マルチアップロード認証"
3059 AuthUserFile $file_path
3060 require valid-user
3061 <Files ~ "^.(htpasswd|htaccess)$">
3062  deny from all
3063 </Files>
3064 EOF
3065             my $htac = join('/', $in_path, $htaccess);
3066             open(HTA,">$htac");
3067             print HTA $hta_str;
3068             close(HTA);
3069         }
3070         my (@del_list, %del_htac, %use_htac, $del_user_name);
3071         foreach my $line (@user) {
3072             my ($tm, $user, $path, $pass, $permit, $l_size,$mail,$mxday,$mxdown) = split(/\,/,$line);
3073             chomp $mxday;
3074             $user = &rechange($user);
3075             my $del = param('del');
3076             my $del_flag = 0;
3077             if ($tm eq $in_tm) {
3078                 $new_data = 0;
3079                 if ($del eq '登録を削除') {
3080                     $del_flag = 1;
3081                     push(@del_list,$user);
3082                     $del_htac{"$user"} = $path;    # .htaccessを削除するディレクトリの候補
3083                     $comment .= qq(<div style="color:red"><strong>$user</strong>を削除しました。</div>);
3084                 } elsif (param('modify')) {
3085                     $in_pass = $pass if !$in_pass;
3086                     $user = $in_user;
3087                     $path = $in_path;
3088                     $pass = $in_pass;
3089                     my $e_in_user = &change($in_user);
3090                     $mxday = $auto_delete if ! $mxday;
3091                     $mxdown = $max_dl_count if ! $mxdown;
3092                     if ($in_path !~ /^$user_root/) {
3093                         $mxday = '';
3094                         $mxdown = '';
3095                     }
3096                     $line = qq($tm,$e_in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,$mxday,$mxdown,\n);
3097                     if ($in_path ne $path) {
3098                         $del_htac{"$user"} = $path;    # ディレクトリが変更された場合も、旧ディレクトリを.htaccessを削除するディレクトリの候補に
3099                     }
3100                     if ($in_user ne $user) {
3101                         $del_user_name = $user;
3102                     }
3103                     $comment .= qq(<span style="color:blue"><strong>$user</strong>の設定を変更しました。</span><br />);
3104                     my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$tm);
3105                     if ($post_only) {
3106                         $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;
3107                     } else {
3108                         $send_mail_link = qq(<a href="$script) . &url_param(%param) . qq("><strong>${user}${mr}</strong>にメールを送る</a>) if $in_mail;
3109                     }
3110                     $comment .= qq(<div style="color:blue">${in_path}を作成しました。</div>) if $dir_flag;
3111                     foreach ('./upload/usr_root','./upload','./upload/root') {
3112                         if ($path eq $_) {
3113                             $comment .= qq(<div style="color:red">ディレクトリを${path}にすると、${user}は${path}内の他のユーザーディレクトリすべてにアクセスできることになります。<br />\n);
3114                             $comment .= qq(特に理由がない限り、${root}/root/guestのように、${root}/rootのサブディレクトリにすることをお勧めします。</div>);
3115                         }
3116                     }
3117                     if ($in_path ne join('/',$root,'root') && index($in_path, join('/',$root,'root')) >= 0 && index($in_path, join('/',$root,'root/')) < 0) {
3118                         $comment .= qq(<div style="color:red">${in_path}は) . join('/',$root,'root') . qq(のサブディレクトリではありません。<br />);
3119                         $comment .= join('/',$root,'root') . qq(を含まない別名のディレクトリか、) . join('/',$root,'root') . qq(のサブディレクトリに変更することをお勧めします。</div>);
3120                     }
3121                 }
3122             }
3123             if (!$del_flag) {
3124                 push(@new_user,$line);
3125                 $use_htac{"$path"} = 1;
3126                 if ($use_htaccess) {
3127                     $path{"$user"} = $path;
3128                     $pass{"$user"} = $pass;
3129                     if ($in_path =~ /^$path/) { push(@parent_user_list,$user); }
3130                     if ($path =~ /^$in_path/) { push(@child_user_list,$user); }
3131                 }
3132             }
3133         }
3134         my $time = time;
3135         if ($new_data && param('new_user')) {
3136             if (!$in_pass) { &error("エラー","パスワードが入力漏れです。"); }
3137             my $e_in_user = &change($in_user);
3138             my $line = qq($time,$e_in_user,$in_path,$in_pass,$in_permit,$in_size,$in_mail,,,\n);
3139             push(@new_user,$line);
3140             $comment .= qq(<div style="color:red"><strong>$in_user</strong>を追加しました。</div>);
3141             my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$time);
3142             if ($post_only) {
3143                 $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;
3144             } else {
3145                 $send_mail_link = qq(<a href="$script?) . &url_param(%param) . qq("><strong>${in_user}${mr}</strong>にメールを送る</a>) if $in_mail;
3146             }
3147             foreach ('./upload/usr_root','./upload','./upload/root') {
3148                 if ($in_path eq $_) {
3149                     $comment .= qq(<div style="color:red">ディレクトリを${in_path}にすると、${in_user}は${in_path}内の他のユーザーディレクトリすべてにアクセスできることになります。<br />\n);
3150                     $comment .= qq(特に理由がない限り、${root}/root/guestのように、${root}/rootのサブディレクトリにすることをお勧めします。</div>);
3151                 }
3152             }
3153             if ($in_path ne join('/',$root,'root') && index($in_path, join('/',$root,'root')) >= 0 && index($in_path, join('/',$root,'root/')) < 0) {
3154                 $comment .= qq(<div style="color:red">${in_path}は) . join('/',$root,'root') . qq(のサブディレクトリではありません。<br />);
3155                 $comment .= join('/',$root,'root') . qq(を含まない別名のディレクトリか、) . join('/',$root,'root') . qq(のサブディレクトリに変更することをお勧めします。</div>);
3156             }
3157         }
3158         open(USR,">./user.cgi");
3159         print USR @new_user;
3160         close(USR);
3161         
3162         my %regtm;
3163         foreach (@new_user) {
3164             my $tm = (split(/\,/))[0];
3165             $regtm{"$tm"} = 1;    # 登録エポック時間をキーにしたハッシュを作成
3166         }
3167         if ($new_data) {
3168             my $e_raw_pass = &change($raw_pass);
3169             my $line = qq($time,$e_raw_pass,\n);
3170             push(@raw_pass,$line);
3171         } elsif ($raw_pass) {
3172             my @new_raw_pass = ();
3173             my $add;
3174             foreach my $line (@raw_pass) {
3175                 my $tm = (split(/,/,$line))[0];
3176                 if ($in_tm == $tm) {
3177                     my $e_raw_pass = &change($raw_pass);
3178                     $line = qq($in_tm,$e_raw_pass,\n);
3179                 }
3180                 if ($regtm{"$tm"}) {
3181                     push(@new_raw_pass,$line);    # user.cgiに登録が無いものは削除
3182                     $add = 1 if $tm == $in_tm;
3183                 }
3184             }
3185             # 更新分の生パスワードがなければ追加。通常は必要ないはずだが
3186             if (! $add) {
3187                 my $line = qq($in_tm,) . param('in_pass') . qq(,\n);
3188                 push(@new_raw_pass,$line);
3189             }
3190             @raw_pass = @new_raw_pass;
3191         }
3192         if ($new_data || $raw_pass) {
3193             my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
3194             open(RAW,">$raw_pass_path");
3195             print RAW @raw_pass;
3196             close(RAW);
3197         }
3198         if (param('del') eq '登録を削除') {
3199             my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
3200             my @raw_pass_list = &read_file($raw_pass_path);
3201             open(RAW,">$raw_pass_path");
3202             foreach (@raw_pass_list) {
3203                 if ((split(/,/))[0] != param('in_tm')) { print RAW $_; }
3204             }
3205             close(RAW);
3206         }
3207         if ($use_htaccess) {
3208             if (param('del') eq '登録を削除') {
3209                 if (-e $pass_file_path) {
3210                     if (open(PAS,"$pass_file_path")) {
3211                         my @pass_list = <PAS>;
3212                         close(PAS);
3213                         my @new_pass_list = ();
3214                         foreach (@pass_list) {
3215                             my ($id,$pass) = split(/:/);
3216                             if ($id ne $in_user) {
3217                                 push(@new_pass_list,$_);
3218                             }
3219                         }
3220                         if (@new_pass_list) {
3221                             open(PAS,">$pass_file_path");
3222                             print PAS @new_pass_list;
3223                             close(PAS);
3224                         } else {
3225                             unlink $pass_file_path;
3226                         }
3227                     }
3228                 }
3229                 foreach (@child_user_list) {
3230                     my $tmp_path = $path{"$_"};
3231                     $tmp_path =~ s/^\.\///;
3232                     my $pass_file_path = join('/',$passdir,$tmp_path,'.htpasswd');
3233                     if (-e $pass_file_path) {
3234                         if (open(PAS,"$pass_file_path")) {
3235                             my @pass_list = <PAS>;
3236                             close(PAS);
3237                             my @new_pass_list = ();
3238                             foreach (@pass_list) {
3239                                 my ($id,$pass) = split(/:/);
3240                                 if ($id ne $in_user) {
3241                                     push(@new_pass_list,$_);
3242                                 }
3243                             }
3244                             if (@new_pass_list) {
3245                                 open(PAS,">$pass_file_path");
3246                                 print PAS @new_pass_list;
3247                                 close(PAS);
3248                             } else {
3249                                 unlink $pass_file_path;
3250                             }
3251                         }
3252                     }
3253                 }
3254                 #要追加 登録を削除することによって、ルートディレクトリに指定するユーザーがいなくなったディレクトリは、.htaccessファイルを削除する。
3255                 my $del_htac = $del_htac{"$in_user"};
3256                 if ($del_htac && ! $use_htac{"$del_htac"}) {
3257                     if (unlink join('/',$del_htac{"$in_user"},$htaccess)) {
3258                         $comment .= qq(<div style="color:red"><strong>) . join('/',$del_htac{"$in_user"},$htaccess) . qq(</strong>を削除しました。</div>);
3259                     }
3260                     my $tmp = $del_htac{"$in_user"};
3261                     $tmp =~ s/^\.\///;
3262                     if (unlink join('/',$passdir,$tmp,'.htpasswd')) {
3263                         $comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>を削除しました。</div>);
3264                     }
3265                 }
3266             } else {    # 追加・修正の場合
3267 
3268                 # $pass_file_pathにIDとパスワードを書き込む。
3269                 # 書き込むのは$huser,$hpassと@parent_user_list内のユーザーのIDとパスワード
3270                 # @parent_user_list内のユーザーのルートディレクトリは $path{"$_"}。
3271                 # パスワード保存ファイルは join('/',$passdir,$path{"$_"},'.htpasswd')となる。
3272                 # これを開いてユーザー名と暗号化されていないパスワードを得る。
3273                 my (@pass_list);
3274                 foreach my $user (@parent_user_list) {
3275                     next if $user =~ /^\s+$/;    # 空行処理
3276                     push(@pass_list, qq($user:$pass{"$user"})) if $user ne $in_user;
3277                 }
3278                 push(@pass_list,qq($in_user:$in_pass));
3279                 push(@pass_list,qq($admin_id:$adminpass));    # 管理者のIDとパスも追加
3280                 my $tmp_path = $in_path;
3281                 $tmp_path =~ s/^\.\///;
3282                 open(NEW,'>' . join('/',$passdir,$tmp_path,'.htpasswd'));
3283                 foreach (@pass_list) {
3284                     print NEW $_ . "\n";
3285                 }
3286                 close(NEW);
3287                 
3288                 # 下層ディレクトリにもパスワード保存
3289                 @dir_list = ();
3290                 &get_subdir(join('/',$passdir,$tmp_path));
3291                 foreach my $path (@dir_list) {
3292                     my $tmp_path = $path;
3293                     $tmp_path =~ s/^\.\///;
3294                     if (open(PAS,join('/',$path,'.htpasswd'))) {
3295                         my @pass_list = <PAS>;
3296                         close(PAS);
3297                         my (@new_pass_list);
3298                         my $add = 1;
3299                         foreach my $line (@pass_list) {
3300                             next if $line =~ /^\s+$/;    # 空行処理
3301                             chomp $line;
3302                             my ($id,$pass) = split(/:/,$line);
3303                             if ($id eq $in_user) {
3304                                 $line = qq($in_user:$in_pass);
3305                                 $add= 0;
3306                             }
3307                             push(@new_pass_list,$line);
3308                         }
3309                         if ($add) {
3310                             push(@new_pass_list,qq($in_user:$in_pass));
3311                         }
3312                         open(PAS,">" . join('/',$path,'.htpasswd'));
3313                         foreach (@new_pass_list) {
3314                             print PAS $_ . "\n";
3315                         }
3316                         close(PAS);
3317                     }
3318                 }
3319             }
3320         }
3321         
3322         #### user.cgiの内容と照合して不要なファイルなどを整理
3323         my (%set_htac, %path_);
3324         foreach my $line (@new_user) {
3325             my ($tm, $user, $path, $pass, $permit, $l_size, $mail) = split(/\,/,$line);
3326             $user = &rechange($user);
3327             $set_htac{"$path"} = 1;
3328             $path_{"$user"} = $path
3329         }
3330         @dir_list = ();
3331         &get_subdir($updir);
3332         unshift(@dir_list,$updir);
3333         foreach my $dir (@dir_list) {
3334             if (-e join('/',$dir,$htaccess) && ! $set_htac{"$dir"}) {
3335                 if (unlink join('/',$dir,$htaccess)) {
3336                     $comment .= qq(<div style="color:red"><strong>) . join('/',$dir,$htaccess) . qq(</strong>を削除しました</div>\n);
3337                 } else {
3338                     $comment .= qq(<div style="color:red"><strong>) . join('/',$dir,$htaccess) . qq(</strong>を削除できませんでした</div>\n);
3339                 }
3340             }
3341             my $tmp = $dir;
3342             $tmp =~ s/^\.\///;
3343             if (-e join('/',$passdir,$tmp,'.htpasswd')) {
3344                 if (! $set_htac{"$dir"}) {
3345                     if (unlink join('/',$passdir,$tmp,'.htpasswd')) {
3346                         $comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>を削除しました</div>\n);
3347                     } else {
3348                         $comment .= qq(<div style="color:red"><strong>) . join('/',$passdir,$tmp,'.htpasswd') . qq(</strong>を削除できませんでした</div>\n);
3349                     }
3350                 } else {
3351                     if (open(HTPAS,join('/',$passdir,$tmp,'.htpasswd'))) {
3352                         my @pass_list = <HTPAS>;
3353                         close(HTPAS);
3354                         my @new_pass_list = ();
3355                         foreach (@pass_list) {
3356                             my ($id, $pass) = split(/:/);
3357                             if (index($dir,$path_{"$id"}) < 0) {
3358                                 $comment .= qq(<div style="color:red">) . join('/',$passdir,$tmp,'.htpasswd') . qq(の${id}を削除しました。</div>\n);
3359                             } else {
3360                                 push(@new_pass_list,$_);
3361                             }
3362                         }
3363                         open(HTPAS,">" . join('/',$passdir,$tmp,'.htpasswd'));
3364                         print HTPAS @new_pass_list;
3365                         close(HTPAS);
3366                     }
3367                 }
3368             }
3369         }
3370         &unlock();
3371     } elsif (param('new_user')) {
3372         $comment .= qq(<div style="color:red">ユーザー名が未記入です。</div>\n);
3373     }
3374     my (@user, @raw_pass);
3375     @user = &read_file("./user.cgi");
3376     @raw_pass = &read_file(join('/',$passdir,'raw_pass.cgi'));
3377     my $html;
3378     if (param('show_log')) {
3379         my $log_path = join('/',$access_dir,param('show_log') . '.cgi');
3380         if (open(LOG,"$log_path")) {
3381             my @log = <LOG>;
3382             close(LOG);
3383             my $user = &rechange((split(/\,/,$log[0]))[0]);
3384             
3385             $html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="アクセスログ">\n);
3386             $html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>のアクセスログ</caption>\n);
3387             $html .= qq(<tr><th>アクセス時間</th><th>ホスト</th></tr>\n);
3388             @log =reverse @log;
3389             foreach (@log) {
3390                 my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3391                 $ax_tm =~ s/(\(日\))/<span style="color:red">$1<\/span>/;
3392                 $ax_tm =~ s/(\(土\))/<span style="color:blue">$1<\/span>/;
3393                 $html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3394             }
3395             $html .= qq(</table>\n</div>\n);
3396         }
3397         my $log_patht = $log_path;
3398         $log_patht =~ s/(\.cgi$)/t$1/;
3399         if (open(LOG,"$log_patht")) {
3400             my @log = <LOG>;
3401             close(LOG);
3402             my $user = &rechange((split(/\,/,$log[0]))[0]);
3403             $html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="アクセスログ">\n);
3404             $html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>のアクセスログ</caption>\n);
3405             $html .= qq(<tr><th>アクセス時間</th><th>ホスト</th></tr>\n);
3406             @log = reverse @log;
3407             foreach (@log) {
3408                 my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3409                 $ax_tm =~ s/(\(日\))/<span style="color:red">$1<\/span>/;
3410                 $ax_tm =~ s/(\(土\))/<span style="color:blue">$1<\/span>/;
3411                 $html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3412             }
3413             $html .= qq(</table>\n</div>\n);
3414         }
3415         my $log_pathg = $log_path;
3416         $log_pathg =~ s/(\.cgi$)/g$1/;
3417         if (open(LOG,"$log_pathg")) {
3418             my @log = <LOG>;
3419             close(LOG);
3420             my $user = &rechange((split(/\,/,$log[0]))[0]);
3421             $html .= qq(<div style="margin:0.5em">\n<table border="1" cellspacing="0" cellpadding="2" summary="アクセスログ">\n);
3422             $html .= qq(<caption style="white-space:nowrap;"><strong>$user</strong>のアクセスログ</caption>\n);
3423             $html .= qq(<tr><th>アクセス時間</th><th>ホスト</th></tr>\n);
3424             @log = reverse @log;
3425             foreach (@log) {
3426                 my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
3427                 $ax_tm =~ s/(\(日\))/<span style="color:red">$1<\/span>/;
3428                 $ax_tm =~ s/(\(土\))/<span style="color:blue">$1<\/span>/;
3429                 $html .= qq(<tr><td>$ax_tm</td><td>$host</td></tr>\n);
3430             }
3431             $html .= qq(</table>\n</div>\n);
3432         }
3433         if (! $html) {
3434             $html = 'ログはありません';
3435         }
3436         return $html;
3437     }
3438     my ($time_sort, $name_sort, $dir_sort, $mail_sort,$acc_sort,%order,$tindx, %time, %host);
3439     my $page = param('page');
3440     $time_sort = 'time';
3441     $order{'time'} = '(降順)';
3442     $name_sort = 'name';
3443     $order{'name'} = '(降順)';
3444     $dir_sort = 'dir';
3445     $order{'dir'} = '(降順)';
3446     $mail_sort = 'mail';
3447     $order{'mail'} = '(降順)';
3448     $acc_sort = 'acc';
3449     $order{'acc'} = '(降順)';
3450     if ($sort =~ /^time/) {
3451         if ($sort eq 'time') {
3452             $time_sort = 'time_r';
3453             $order{'time'} = '(昇順)';
3454         }
3455     }
3456     if ($sort =~ /^name/) {
3457         if ($sort eq 'name') {
3458             $name_sort = 'name_r';
3459             $order{'name'} = '(昇順)';
3460         }
3461     }
3462     if ($sort =~ /^dir/) {
3463         if ($sort eq 'dir') {
3464             $dir_sort = 'dir_r';
3465             $order{'dir'} = '(昇順)';
3466         }
3467     }
3468     if ($sort =~ /^mail/) {
3469         if ($sort eq 'mail') {
3470             $mail_sort = 'mail_r';
3471             $order{'mail'} = '(昇順)';
3472         }
3473     }
3474     if ($sort =~ /^acc/) {
3475         if ($sort eq 'acc') {
3476             $acc_sort = 'acc_r';
3477             $order{'acc'} = '(昇順)';
3478         }
3479     }
3480 
3481     $tindx = 0;
3482     my ($fuser,$fpath,$fpass,$fpermit,$fl_size,$fkl_size,$ftm,$fmail,$fauto_del,$fmax_dl);
3483     foreach (@user) {
3484         my ($tm, $user, $path, $pass, $permit, $l_size, $mail,$auto_del,$max_dl) = split/\,/;
3485         if (param("$tm") || param('in_tm') eq $tm) {
3486             $user = &rechange($user);
3487             $ftm = $tm;
3488             $fuser =$user;
3489             $fpath = $path;
3490             $fmail = $mail;
3491             $fpass = $pass;
3492             $fpermit = $permit;
3493             $fl_size = $l_size;
3494             $fkl_size = int($l_size / (1024 * 1024));
3495             $fauto_del = $auto_del;
3496             $fmax_dl = $max_dl;
3497         }
3498     }
3499     my ($button, $table_col);
3500     my ($auto_pass, $passcom, $auto_pass_com,$auto_path_str);
3501     my $active_col = '#ffffbb';
3502     if (param('auto_pass') || param('auto_pass_re')) {
3503         my ($al,$dg,$mk,$length,$al_chk,$dg_chk,$mk_chk,$hidden);
3504         $length = param('length');
3505         if (param('auto_pass')) {
3506             $al = 1;
3507             $dg = 1;
3508             $mk = 1;
3509             $length = $pass_length + 2;
3510         } elsif (param('auto_pass_re')) {
3511             $al = param('al');
3512             $dg = param('dg');
3513             $mk = param('mk');
3514             $al = 1 if ! $al && ! $dg && !$mk;
3515         }
3516         $auto_path_str = 'パスワード再生成';
3517         $al_chk = qq( checked="checked") if $al;
3518         $dg_chk = qq( checked="checked") if $dg;
3519         $mk_chk = qq( checked="checked") if $mk;
3520         $auto_pass = &auto_pass($length,$al,$dg,$mk);
3521         $auto_pass_com = qq(<br /><input type="submit" name="auto_pass_re" value="$auto_path_str" style="font-size:80%" /><br />);
3522         my $length_com = qq(<select name="length">\n);
3523         for (my $i=$pass_length; $i <= ($pass_length + 10); $i++) {
3524             my $sel;
3525             if ($length == $i) {
3526                 $sel = qq( selected="selected");
3527             }
3528             $length_com .= qq(<option value="$i"$sel>$i</option>);
3529         }
3530         $length_com .= qq(</select>文字);
3531         $auto_pass_com .= qq(<input type="checkbox" name="al"$al_chk value="1" />英&nbsp;<input type="checkbox" name="dg"$dg_chk value="1" />数&nbsp;<input type="checkbox" name="mk"$mk_chk value="1" />記号$length_com<br />);
3532     } else {
3533         $auto_pass_com = qq(<br /><input type="submit" name="auto_pass" value="パスワードを自動生成する" style="font-size:80%" />);
3534     }
3535     my $reset;
3536     $reset = 1 if param('new_user') || param('modify') || param('del');
3537     my @perm = (' checked="checked"',' checked="checked"','','');
3538     if ($fpermit && ! $reset) {
3539         my $j = 0;
3540         for(my $i = 1; $i <= 8; $i *= 2){
3541             if($fpermit & $i){
3542                 $perm[$j] = ' checked="checked"';
3543             } else {
3544                 $perm[$j] = '';
3545             }
3546             $j++;
3547         }
3548     }
3549     my $limit_size = 1024 * 1024 * $max_mb;
3550     my $k_limit_size = int($limit_size / (1024 * 1024));
3551     if (($ftm || param('in_tm')) && ! $reset) {
3552         $k_limit_size = $fkl_size;
3553         $tindx++;
3554         $button .= qq(<input type="submit" name="modify" value="以下の登録を修正" tabindex="$tindx" />&nbsp;);    $tindx++;
3555         $button .= qq(<input type="submit" name="del" value="登録を削除" tabindex="$tindx" />);    $tindx++;
3556         $table_col = qq(background-color:$active_col);
3557         $passcom = qq(<br /><span style="font-size:80%;color:red">パスワードを変更する場合だけ入力してください</span>);
3558     } else {
3559         $tindx++;
3560         $button .= qq(<input type="submit" name="new_user" value="以下の内容で追加" tabindex="$tindx" />);    $tindx++;
3561         $fpath = $root . '/root';
3562     }
3563     my $max_size_tab = $tindx;
3564     $fuser = param('in_user') if param('in_user') && ! $reset;
3565     $fpath = param('in_path') if param('in_path') && ! $reset;
3566     $fmail = param('in_mail') if param('in_mail') && ! $reset;
3567     $k_limit_size = param('in_size') if param('in_size');
3568     $fuser = $fmail = $ftm = '' if $reset;
3569     $perm[2] = ' checked="checked"' if param('permission');
3570     $perm[3] = ' checked="checked"' if param('cgi');
3571     my $fuser_length = length($fuser) * 1.2;
3572     my $fpath_size = length($fpath);
3573     $fpath_size = qq( size=") . int($fpath_size * 1.6) . qq(") if $fpath_size;
3574     my $pass_size = length($auto_pass);
3575     $pass_size = 16 if $pass_size < 16;
3576     $pass_size = qq( size=") . int($pass_size * 1.2) . qq(") if $pass_size;
3577     my $usr_form;
3578     $usr_form .= qq(<div style="padding:0.5em"><a name="anchor" id="anchor" style="padding:0.5em">&nbsp;</a>$comment</div>\n) if $comment;
3579     $usr_form .= qq(<div style="padding:0.5em">$send_mail_link</div>\n) if $send_mail_link;
3580     my %param = ('login_admin'=>$login_admin,'mode'=>$mode,'mode2'=>'user','in_tm'=>$ftm,'page'=>$page);
3581     my $hidden = &hidden_param(%param);
3582     $usr_form .= << "___USERFORM___";
3583 <form action="${script}#anchor" method="post" style="margin:0">
3584 $hidden
3585 <table border="1" cellpadding="4" cellspacing="0" style="margin:4px 0 4px 0;$table_col" summary="ユーザー入力フォーム">
3586 ___USERFORM___
3587     if (param('auto_pass') || param('auto_pass_re')) {
3588         $usr_form .= qq(<caption style="text-align:left;"><a name="anchor" id="anchor" style="padding:0.5em">ユーザー入力フォーム</a></caption>);
3589     } else {
3590         $usr_form .= qq(<caption style="text-align:left;"><a name="input" id="input" style="padding:0.5em">ユーザー入力フォーム</a></caption>);
3591     }
3592     $usr_form .= qq( <tr>\n <th colspan="2">$button<input type="reset" value="リセット" tabindex="$tindx" /></th>\n </tr>\n);    $tindx++;
3593     $usr_form .= qq( <tr>\n <th>ユーザー名</th>\n <td><input type="text" size="$fuser_length" name="in_user" value="$fuser" tabindex="$tindx" />\n</td>\n </tr>\n);    $tindx++;
3594     $usr_form .= qq( <tr>\n <th>パスワード</th>\n <td><input type="text" name="in_pass" value="$auto_pass" style="ime-mode:disabled;" tabindex="$tindx"$pass_size />$passcom\n);
3595     $usr_form .= qq($auto_pass_com</td>\n </tr>\n);    $tindx++;
3596     $usr_form .= qq( <tr>\n <th>ディレクトリ</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%">(これより上位のディレクトリにはアクセスできません)</span></td>\n </tr>\n);    $tindx++;
3597     $usr_form .= qq( <tr>\n <th><span style="white-space:nowrap;">メールアドレス</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++;
3598     $usr_form .= qq( <tr>\n <th>許可する操作</th>\n <td>);
3599     $usr_form .= qq(<input type="checkbox" name="upload" value="1"$perm[0] tabindex="$tindx" />作成<span style="font-size:80%">&nbsp;\(ファイルのアップロード、ディレクトリの作成\)</span><br />\n);    $tindx++;
3600     $usr_form .= qq(<input type="checkbox" name="delete" value="1"$perm[1] tabindex="$tindx" />削除<span style="font-size:80%">&nbsp;\(ファイル、ディレクトリの削除\)</span><br />\n);    $tindx++;
3601     $usr_form .= qq(<input type="checkbox" name="permission" value="1"$perm[2] tabindex="$tindx" />属性の変更<br />\n);    $tindx++;
3602     my $pex = '';
3603     if ($prohibit_ext) {
3604         my ($ex1,$ex2) = split(/\,/,$prohibit_ext);
3605         $pex = qq(<span style="font-size:80%">&nbsp;\(<strong>.${ex1}</strong>、<strong>.${ex2}</strong>などの拡張子のファイル\)&nbsp;</span>);
3606     }
3607     $usr_form .= qq(<input type="checkbox" name="cgi" value="1"$perm[3] tabindex="$tindx" />禁止ファイル$pexの操作</td>\n </tr>\n);    $tindx++;
3608     $usr_form .= qq( <tr>\n <th>容量制限</th>\n <td><input type="text" size="12" name="in_size" value="$k_limit_size" style="ime-mode:disabled;" tabindex="$tindx" /> MB&nbsp;<span style="font-size:80%">\(0だと無制限\)</span></td>\n </tr>\n);    $tindx++;
3609     $usr_form .= qq(</table>\n</form>\n);
3610 
3611     my @access = &read_file($access);
3612     my (@acc_list,%acc_ord);
3613     if($save_log){
3614         foreach(@access){
3615             my($ac_user, $ac_time, $ac_host,$reg_tm) = split(/\,/);
3616             $time{"$reg_tm"} = $ac_time if !$time{"$reg_tm"};
3617             $host{"$reg_tm"} = $ac_host if !$host{"$reg_tm"};
3618             $ac_user =~ s/\(.+\)$//;
3619             push(@acc_list,$ac_user) if $ac_user ne $admin_id;
3620         }
3621         @acc_list = &get_unique(@acc_list);
3622         my $i = 0;
3623         foreach (@acc_list) {
3624             $acc_ord{"$_"} = $i++;
3625         }
3626         # アクセスログに入っていないユーザーも追加しておく
3627         foreach (@user) {
3628             my $usr = (split(/\,/))[1];
3629             if (! exists $acc_ord{"$usr"}) {
3630                 $acc_ord{"$usr"} = $i++;
3631             }
3632         }
3633     }
3634     my $total_size = &size_measure($root);
3635     my $usr_nmb = scalar(@user);
3636     my $usr_nmb_com;
3637     $usr_nmb_com = '<a name="user_index" id="user_index" style="padding:0.5em">登録されているユーザー</a>&nbsp;<strong>' . $usr_nmb . "人</strong>&nbsp;&nbsp;\n";
3638     $usr_nmb_com .= qq(<table summary="登録一覧インデックス"><tr>\n);
3639     $page = 0 if ! $page;
3640     if ($usr_nmb > $max_user) {
3641         my $lft = $page * $max_user + 1;
3642         my $rgt = ($page + 1) * $max_user;
3643         $rgt = $usr_nmb if $rgt > $usr_nmb;
3644         my $end_page = int($usr_nmb / $max_user);
3645         for (my $i = 0; $i <= $end_page; $i++) {
3646             my $start = $i * $max_user + 1;
3647             next if $start > $usr_nmb;
3648             my $end = ($i + 1) * $max_user;
3649             my $sort = param('sort');
3650             my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'user','sort'=>$sort,'page'=>$i);
3651             my $link = qq($script) . &url_param(%param) . qq(#user_index);
3652             $end = $usr_nmb if $end > $usr_nmb;
3653             if (param('page') == $i) {
3654                 if ($start == $end) {
3655                     if ($post_only) {
3656                         $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>);
3657                     } else {
3658                         $usr_nmb_com .= qq(<td>[<a href="$link" style="color:red">$start</a>]&nbsp;</td>);
3659                     }
3660                 } else {
3661                     if ($post_only) {
3662                         $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>);
3663                     } else {
3664                         $usr_nmb_com .= qq(<td>[<a href="$link" style="color:red">$start〜$end</a>]&nbsp;</td>);
3665                     }
3666                 }
3667             } else {
3668                 if ($start == $end) {
3669                     if ($post_only) {
3670                         $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>);
3671                     } else {
3672                         $usr_nmb_com .= qq(<td>[<a href="$link">$start</a>]&nbsp;</td>);
3673                     }
3674                 } else {
3675                     if ($post_only) {
3676                         $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>);
3677                     } else {
3678                         $usr_nmb_com .= qq(<td>[<a href="$link">$start〜$end</a>]&nbsp;</td>);
3679                     }
3680                 }
3681             }
3682         }
3683     }
3684     $usr_nmb_com .= qq(</tr></table>\n);
3685     $total_size = &kiro_byte($total_size);
3686     my $add_input;
3687     # ユーザーを指定してユーザーの設定がユーザー入力フォームに表示されている場合
3688     if ($ftm) {
3689         $add_input = qq(<caption style="text-align:left;">\n);
3690         $add_input .= qq(<form action="$script" method="post" style="margin:0">\n);
3691         $add_input .= qq(<input type="hidden" name="mode" value="$mode">\n);
3692         $add_input .= qq(<input type="hidden" name="mode2" value="user">\n);
3693         $add_input .= qq(<input type="hidden" name="login_admin" value="$login_admin">\n);
3694         $add_input .= qq(<input type="hidden" name="sort" value="$sort">\n);
3695         $add_input .= qq(<input type="hidden" name="page" value="$page">\n);
3696         $add_input .= qq(<input type="submit" name="new" value="新規ユーザーを追加" tabindex="$tindx" />\n);
3697         $add_input .= qq(</form>\n);
3698         $add_input .= qq(</caption>\n);    $tindx++;
3699     }
3700     my $search = qq(<form action="${script}#user_index" method="post">\n
3701 <input type="hidden" name="mode" value="$mode" />
3702 <input type="hidden" name="mode2" value="user" />
3703 <input type="hidden" name="login_admin" value="$login_admin" />
3704 <input type="hidden" name="sort" value="$sort" />);
3705     my $key;
3706     $key = param('key') if ! param('clear');
3707     $search .= qq(<input type="text" name="key" value="$key" />&nbsp;<input type="submit" name="search" value="ユーザーを検索" />&nbsp;<input type="submit" name="clear" value="クリア" /></form>\n);
3708     if (param('search') && param('key')) {
3709         $usr_nmb_com = '<hit_count>';
3710     }
3711     my $hid;
3712     if ($key) {
3713         $hid .= qq(<input type="hidden" name="key" value="$key" />\n);
3714         $hid .= qq(<input type="hidden" name="search" value="1" />\n);
3715     }
3716     my $raw_pass_alarm;
3717     if (scalar(@raw_pass)) {
3718         if (scalar(@raw_pass) < scalar(@user)) {
3719             $raw_pass_alarm = qq(生パスワードが保存されていないユーザーがいます。);
3720         }
3721     } else {
3722         if (! -e join('/',$passdir,'raw_pass.cgi') && scalar(@user) > 0) {
3723             $raw_pass_alarm = qq(生パスワードが保存されていません。);
3724         } elsif (scalar(@user) > 0) {
3725             $raw_pass_alarm = qq(生パスワードが保存されていないユーザーがいます。);
3726         }
3727     }
3728     my $edit_form =<<"EOF";
3729 <form action="${script}#input" method="post" style="margin:0;padding:0">
3730 <input type="hidden" name="mode" value="$mode" />
3731 <input type="hidden" name="mode2" value="user" />
3732 <input type="hidden" name="login_admin" value="$login_admin" />
3733 <input type="hidden" name="sort" value="$sort" />
3734 <input type="hidden" name="page" value="$page" />
3735 $hid
3736 EOF
3737     $html .= << "EOF";
3738 $usr_nmb_com$search
3739 <span style="color:red">$raw_pass_alarm</span>
3740 <table border="1" cellpadding="4" cellspacing="0" style="margin:4px 0 4px 0;font-size:90%" summary="登録されているユーザー">
3741 $add_input
3742 <tr>
3743 <th rowspan="2">&nbsp;</th>
3744 EOF
3745     undef %param;
3746     %param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$time_sort,'mode2'=>'user');
3747     if ($post_only) {
3748         $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="登録日時" title="登録日時でソ\ート$order{'time'}" /></form></th>\n);
3749     } else {
3750         $html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="登録日時でソ\ート$order{'time'}">登録日時</a></th>);
3751     }
3752     $param{'sort'} = $name_sort;
3753     if ($post_only) {
3754         $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="ユーザー名" title="ユーザー名でソ\ート$order{'name'}" /></form></th>\n);
3755     } else {
3756         $html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="ユーザー名でソ\ート$order{'name'}">ユーザー名</a></th>\n);
3757     }
3758     $param{'sort'} = $dir_sort;
3759     if ($post_only) {
3760         $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="ディレクトリ" title="ディレクトリ名でソ\ート$order{'dir'}" /></form></th>\n);
3761     } else {
3762         $html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="ディレクトリ名でソ\ート$order{'dir'}">ディレクトリ</a></th>\n);
3763     }
3764     $param{'sort'} = $mail_sort;
3765     if ($post_only) {
3766         $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="メールアドレス" title="メールアドレスでソ\ート$order{'mail'}" /></form></th>\n);
3767     } else {
3768         $html .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="メールアドレスでソ\ート$order{'mail'}">メールアドレス</a></th>\n);
3769     }
3770     $param{'sort'} = $acc_sort;
3771     my $colplus;
3772     if ($post_only) {
3773         $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="最終アクセス時間" title="最終アクセス時間でソ\ート$order{'acc'}" /></form></th>\n);
3774     } else {
3775         $colplus .= qq(<th rowspan="2"><a href="$script) . &url_param(%param) . qq(#user_index" title="最終アクセス時間でソ\ート$order{'mail'}">最終アクセス時間</a></th>\n);
3776     }
3777     $colplus .= qq(<th rowspan="2">ホスト</th>\n);
3778     $html .= << "EOF";
3779 <th rowspan="2">容量/最大容量<br /><span style="font-size:80%">(容量合計$total_size)</span></th>
3780 <th colspan="4">許可する操作</th>$colplus
3781 <th rowspan="2">パスワード</th>
3782 </tr>
3783 <tr>
3784 <td><span style="font-size:-1"><a title="ファイルのアップロード、ディレクトリの作成">作成</a></span></td>
3785 <td><span style="font-size:-1"><a title="ディレクトリ、ファイルの削除">削除</a></span></td>
3786 <td><span style="font-size:-1"><a title="ディレクトリ、ファイルのパーミッション変更">属性</a></span></td>
3787 <td><span style="font-size:-1"><a title="禁止ファイルのアップロード">禁止</a></span></td>
3788 </tr>
3789 EOF
3790     my (@updir_list, %dir_user, %tm);
3791     $sort = 'time_r' if ! $sort;
3792     if ($sort eq 'time') {
3793         @user = map {$_->[0]} sort {$a->[1] cmp $b->[1]} map {[$_, split /\,/]} @user;
3794     } elsif ($sort eq 'time_r') {
3795         @user = map {$_->[0]} sort {$b->[1] cmp $a->[1]} map {[$_, split /\,/]} @user;
3796     } elsif ($sort eq 'name') {
3797         @user = map {$_->[0]} sort {$a->[2] cmp $b->[2]} map {[$_, split /\,/]} @user;
3798     } elsif ($sort eq 'name_r') {
3799         @user = map {$_->[0]} sort {$b->[2] cmp $a->[2]} map {[$_, split /\,/]} @user;
3800     } elsif ($sort eq 'dir') {
3801         @user = map {$_->[0]} sort {$a->[3] cmp $b->[3]} map {[$_, split /\,/]} @user;
3802     } elsif ($sort eq 'dir_r') {
3803         @user = map {$_->[0]} sort {$b->[3] cmp $a->[3]} map {[$_, split /\,/]} @user;
3804     } elsif ($sort eq 'mail') {
3805         @user = map {$_->[0]} sort {$a->[7] cmp $b->[7]} map {[$_, split /\,/]} @user;
3806     } elsif ($sort eq 'mail_r') {
3807         @user = map {$_->[0]} sort {$b->[7] cmp $a->[7]} map {[$_, split /\,/]} @user;
3808     } elsif ($sort eq 'acc') {
3809         @user = map {$_->[0]} sort {$acc_ord{$a->[2]} <=> $acc_ord{$b->[2]}} map {[$_, split /\,/]} @user;
3810     } elsif ($sort eq 'acc_r') {
3811         @user = map {$_->[0]} sort {$acc_ord{$b->[2]} <=> $acc_ord{$a->[2]}} map {[$_, split /\,/]} @user;
3812     }
3813 
3814     my $ad_pass = $pass;
3815     my $user_count = 0;
3816     my $hit_count = 0;
3817     my %rpass;
3818     foreach (@raw_pass) {
3819         my ($tm,$rpass) = split(/\,/);
3820         $rpass{"$tm"} = $rpass;
3821     }
3822     
3823     my @login_list;
3824     opendir(DIR,$logindir);
3825     while (my $file=readdir(DIR)) {
3826         next if $file !~ /\w{10}\.cgi$/;
3827         my $path = join('/',$logindir,$file);
3828         open(GID,$path);
3829         my $id =<GID>;
3830         chomp $id;
3831         close(GID);
3832         push(@login_list,$id);
3833     }
3834     closedir(DIR);
3835 
3836     my $ascii = '[\x00-\x7F]';
3837     my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
3838     my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
3839     foreach(@user){
3840         my ($euc,$key);
3841         if (param('search') && param('key')) {
3842             $key = param('key');
3843             $euc = $_;
3844             if ($encode_lib == 1) {
3845                 eval 'use Jcode;';
3846                 Jcode::convert(\$euc, "euc");
3847                 Jcode::convert(\$key, "euc");
3848             } else {
3849                 require 'jcode.pl';
3850                 &jcode::convert(\$euc, "euc");
3851                 &jcode::convert(\$key, "euc");
3852             }
3853 
3854             # ずれた場所でマッチしてしまうのを回避
3855             if ($euc !~ /^(?:$ascii|$twoBytes|$threeBytes)*?(?:$key)/) {
3856                 $user_count++;
3857                 next;
3858             } else {
3859                 $hit_count++;
3860             }
3861         }
3862         my ($tm, $user, $path, $pass, $permit, $l_size, $mail) = split/\,/, $_;
3863         $user = &rechange($user);
3864         push(@updir_list,$path);
3865         $dir_user{"$path"} .= qq($user,);
3866         $tm{"$path"} = $tm;
3867         if (!(param('search') && param('key')) && ($user_count < $page * $max_user || $user_count >= ($page + 1) * $max_user)) {
3868             $user_count++;
3869             next;
3870         }
3871         my $msg = my $col_col = my $active = '';
3872         if (param("$tm") || param('in_tm') eq $tm) {
3873             $col_col = qq( style="background-color:$active_col");
3874             $active = 1;
3875         } elsif ($path =~ /$user_root/) {
3876             $col_col = qq( style="background-color:$zebra_back_col");
3877         }
3878         my $login;
3879         foreach (@login_list) {
3880             if ($user eq $_) {
3881                 $col_col = qq( style="background-color:#ffccee") if ! $active;
3882                 $login = qq(<span style="font-size:80%;color:red">&nbsp;ログイン中</span>);
3883                 last;
3884             }
3885         }
3886         $msg .= qq(<tr$col_col>\n<td style="text-align:right;">$edit_form<input type="submit" name="$tm" value="編集) . ($user_count + 1) . qq(" tabindex="$tindx" /></form></td>\n);    $tindx++;
3887         my ($sec, $min, $hour, $day, $mon, $year) = localtime($tm);
3888         $year+=1900;
3889         $mon++;
3890         my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
3891         $msg .= qq(<td><span style="font-size:80%">$tm_com</span></td>\n);
3892         
3893         # 登録ユーザーとしてログインするためにユーザーのidをフォーム用パラメータに追加
3894         my %param = ('mode'=>'login','dptid'=>$user);
3895         $msg .= qq(<td><table summary="ユーザーとしてログイン"><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}としてログイン" /></form></td><td>) . &key_color($user,$key) . qq($login</td></tr></table></td>\n);
3896         undef %param;
3897         %param = ('login_admin'=>$login_admin,'dir'=>$path);
3898         if ($post_only) {
3899             $msg .= qq(<td><table summary="ディレクトリ移動"><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}のディレクトリに移動" /></form></td><td>) .&key_color($path,$key) . qq(</td></tr></table></td>\n);
3900         } else {
3901             my $url = qq($script) . &url_param(%param);
3902             $msg .= qq(<td><table summary="ディレクトリ移動"><tr><td><a href="$url" title="${user}${mr}のディレクトリに移動"><span style=""><img border="0" src="./img/dir.gif" alt="${user}${mr}のディレクトリに移動" /></span></a></td><td><a href="$url" title="${user}${mr}のディレクトリに移動">) . &key_color($path,$key) . qq(</a></td></tr></table></td>\n);
3903         }
3904         if ($mail) {
3905             my %param = ('mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'send_mail','tm'=>$tm);
3906             if ($post_only) {
3907                 $msg .= qq(<td><table summary="メール送信"><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);
3908             } else {
3909                 my $url = qq($script) . &url_param(%param);
3910                 $msg .= qq(<td><table summary="メール送信"><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);
3911             }
3912         } else {
3913             $msg .= qq(<td>&nbsp;</td>\n);
3914         }
3915 
3916         #サイズ表示
3917         my $pre_size = &size_measure("$path");
3918         my $tempsize;
3919         if (-e $path) {
3920             $tempsize = &kiro_byte($pre_size);
3921         } else {
3922             $tempsize = '<span style="color:red;font-size:80%">ディレクトリがありません</span>';
3923         }
3924         if ($l_size) {
3925             my $lim_size = $l_size;
3926             my ($style) = '';
3927             if ($pre_size > $lim_size) {
3928                 $style = qq( style="color:red;font-weight:bold");
3929             } elsif ($pre_size / $lim_size > 0.8) {
3930                 $style = qq( style="color:#dd2200;");
3931             }
3932             $msg .= qq(<td align="right"$style>) . $tempsize . " / " . &kiro_byte($lim_size) . "</td>";
3933         } else {
3934             $msg .= "<td align=\"right\">" . $tempsize . " / 制限なし</td>";
3935         }
3936         my @perm = &perm_list($permit);
3937         foreach (@perm) {
3938             if ($_) {
3939                 $msg .= qq(<td align="center">○</td>\n);
3940             } else {
3941                 $msg .= qq(<td align="center">×</td>\n);
3942             }
3943         }
3944         if (! $time{"$tm"}) {
3945             if (! -e join('/',$access_dir,$tm . '.cgi')) {
3946                 $time{"$tm"} = '&nbsp;';
3947             } else {
3948                 open(LOG, join('/',$access_dir,$tm . '.cgi'));
3949                 my @axs = <LOG>;
3950                 close(LOG);
3951                 my $tmp = pop @axs;
3952                 my($ac_user, $ac_time, $ac_host,$reg_tm) = split(/\,/,$tmp);
3953                 $time{"$tm"} = $ac_time;
3954                 $host{"$tm"} = $ac_host;
3955             }
3956         }
3957         if (! $host{"$tm"}) {
3958             $host{"$tm"} = '&nbsp;';
3959         }
3960         if ($time{"$tm"} ne "&nbsp;") {
3961             my $sort = param('sort');
3962             my %param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>'user','show_log'=>$tm);
3963             if ($post_only) {
3964                 $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);
3965             } else {
3966                 $msg .= qq(<td><small><a href="$script) . &url_param(%param) . qq(">$time{"$tm"}</a></small></td>);
3967             }
3968             $msg .= qq(<td><small>$host{"$tm"}</small></td>\n);
3969         } else {
3970             $msg .= qq(<td><small>$time{"$tm"}</small></td><td><small>$host{"$tm"}</small></td>\n);
3971         }
3972         my $alarm;
3973         if (! $rpass{"$tm"}) {
3974             $alarm .= qq(生パスワード&nbsp;NG!<br>);
3975         } else {
3976             my %param = ('mode'=>'admin','login_admin'=>$login_admin,'tm'=>$tm,'show_pass'=>'1');
3977             if ($post_only) {
3978                 $alarm .= qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="******" /></form>\n);
3979             } else {
3980                 $alarm .= qq(<a href="$script) . &url_param(%param) . qq(">******</a>);
3981             }
3982         }
3983         if ($use_htaccess) {
3984             if (! -e join('/',$path,$htaccess)) {
3985                 $alarm .= qq(${htaccess}&nbsp;NG!<br>);
3986             }
3987             $path =~ /$root(.+$)/;
3988             if (! -e qq($passdir/upload) . $1 . '/.htpasswd') {
3989                 $alarm .= qq(.htpasswd&nbsp;NG!);
3990             }
3991         }
3992         $msg .= qq(<td style="text-align:center;"><div style="color:red">$alarm</div></td>\n);
3993         $msg .= qq(</tr>\n);
3994         $html .= $msg;
3995         $user_count++;
3996     }
3997     $html .= qq(</table>\n);
3998     if (param('search') && param('key')) {
3999         if ($hit_count) {
4000             my $hit_com = qq(<span style="color:red"><a name="user_index" id="user_index" style="padding:0.5em">${hit_count}件ヒット!</a></span>\n);
4001             $html =~ s/<hit_count>/$hit_com/;
4002         } else {
4003             my $nohit = '条件に該当するユーザーは見つかりませんでした';
4004             $html =~ s/<hit_count>/$nohit/;
4005         }
4006     }
4007     my (@del_list,%comment,$htacc_table);
4008     $usr_nmb_com =~ s/\sname="user_index"\sid="user_index"//;
4009     $html .= $usr_nmb_com;
4010     $htacc_table .= qq(<div style="text-align:left;white-space:nowrap;"><a href="#top" title="ページトップへ">▲</a>&nbsp;\n);
4011     my $sort = param('sort');
4012     my $page_ = param('page');
4013     my %param_ = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>'user','page'=>$page_,'show_htaccess'=>'0');
4014     if (param('show_htaccess')) {
4015         if ($post_only) {
4016             $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);
4017         } else {
4018             $htacc_table .= qq(<a name="htaccess" id="htaccess" href="$script) . &url_param(%param_) . qq(#htaccess">$htaccessと.htpasswdを隠す</a></div>\n);
4019         }
4020     } else {
4021         $param_{'show_htaccess'} = 1;
4022         if ($post_only) {
4023             $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);
4024         } else {
4025             $htacc_table .= qq(<a name="htaccess" id="htaccess" href="$script) . &url_param(%param_) . qq(#htaccess">$htaccessと.htpasswdを表\示する</a></div>\n);
4026         }
4027     }
4028     $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>アクセスできるユーザー</th></tr>\n) if param('show_htaccess') && @updir_list;
4029     @updir_list = sort &get_unique(@updir_list);
4030     foreach (@updir_list) {
4031         my $htac_file = join('/',$_,$htaccess);
4032         if (-e $htac_file) {
4033             push(@del_list, $htac_file);
4034             my ($cont,@user);
4035             if (open(HTAC,"$htac_file")) {
4036                 my @htac = <HTAC>;
4037                 close(HTAC);
4038                 foreach (@htac) {
4039                     if (/^AuthUserFile\s*(.+)/) {
4040                         $cont = $1;
4041                         last;
4042                     }
4043                 }
4044                 if (-e $cont) {
4045                     if (open(PAS,"$cont")) {
4046                         my @id_list = <PAS>;
4047                         close(PAS);
4048                         foreach (@id_list) {
4049                             my($id,$pass) = split(/:/);
4050                             if ($id) {
4051                                 if ($pass) {
4052                                     push(@user,qq([$id]));
4053                                 } else {
4054                                     push(@user,qq(${id}のパスワードが無効です));
4055                                 }
4056                             }
4057                         }
4058                     }
4059                 } else {
4060                     if ($cont) {
4061                         $cont =~ s/^$fullpath/\./;
4062                         $cont = qq(<span style="color:red">${cont}が存在しません</span>);
4063                     }
4064                     push(@user,qq(&nbsp;))
4065                 }
4066             }
4067             $cont =~ s/^$fullpath/\./;
4068             $htacc_table .= qq(<tr><td>${htac_file}</td><td>$cont</td><td>@user</td></tr>\n) if (param('show_htaccess'));
4069         } else {
4070             $dir_user{"$_"} =~ s/,$//;
4071             my @dir_user = split(/,/,$dir_user{"$_"});
4072             my $com;
4073             if (@dir_user) {
4074                 if (scalar(@dir_user) > 1) {
4075                     $com = qq(<span style="color:red">) . join('か',@dir_user) . qq(を再編集してください</span>);
4076                 } else {
4077                     $com = qq(<span style="color:red"><a href="$script?mode=admin&amp;mode2=user&amp;login_admin=$login_admin&amp;$tm{"$_"}=) . &url_encode('再編集') . qq(#input">) . $dir_user[0] . qq(を再編集してください</a></span>);
4078                 }
4079             } else {
4080                 $com = "&nbsp;";
4081             }
4082             $htacc_table .= qq(<tr><td><span style="color:red">${htac_file}がありません</span></td><td colspan="2">$com</td></tr>\n) if (param('show_htaccess'));
4083         }
4084     }
4085     $htacc_table .= qq(</table>\n) if param('show_htaccess') && @updir_list;
4086     if (! $use_htaccess && @del_list) {
4087         if (param('del_htaccess')) {
4088             foreach (@del_list) {
4089                 if (unlink $_) {
4090                     $comment{'htac'} .= qq(<div style="color:red"><strong>$_</strong>を削除しました</div>);
4091                 } else {
4092                     $comment{'htac'} .= qq(<div style="color:red"><strong>$_</strong>を削除できませんでした</div>);
4093                 }
4094             }
4095         } else {
4096             $comment{'htac'} .= qq(.htaccessを使用しない設定ですが<br />\n<div style="color:blue">\n);
4097             foreach (@del_list) {
4098                 $comment{'htac'} .= $_ . "<br />";
4099             }
4100             $comment{'htac'} .= qq(</div>\nが存在します。削除しますか?<br />\n);
4101             $comment{'htac'} .= qq(<a href="$script?mode=admin&amp;mode2=user&amp;id=) . &url_encode($id) . qq(&amp;login_admin=$login_admin&amp;del_htaccess=1">削除する</a>);
4102         }
4103     }
4104     $html .= qq(<div style="padding:0.5em"><a name="anchor" id="anchor">$comment{'htac'}</a></div>) if $comment{'htac'};
4105     $html = '' if ! scalar(@user);
4106     $html = $usr_form . $html;
4107     $html .= $htacc_table if $use_htaccess && scalar(@user);
4108     return $html;
4109 }
4110 
4111 
4112 sub show_acc_log {
4113     my $html;
4114     $html .= qq(<table border="1" cellpadding="4" cellspacing="0" summary="アクセスログ" style="margin:4px 0 4px 0"><tr><th colspan="3"><a name="acc_log" id="acc_log">アクセスログ</a></th></tr>\n);
4115     $html .= qq(<tr><th>ユーザー名</th><th>アクセス時間</th><th>ホスト</th></tr>\n);
4116     my @access = &read_file($access);
4117     my $count = 0;
4118     foreach(@access){
4119         my ($ac_user, $ac_time, $ac_host, $tm) = split(/\,/);
4120         $ac_user = &rechange($ac_user);
4121         my $ac_time_o = $ac_time;
4122         $ac_time =~ s/(\(日\))/<span style="color:red">$1<\/span>/;
4123         $ac_time =~ s/(\(土\))/<span style="color:blue">$1<\/span>/;
4124         if ($ac_user =~ /\(限定なしゲスト\)$/) {
4125             $tm .= 'g';
4126         } elsif ($ac_user =~ /\(ゲスト\)$/) {
4127             $tm .= 't';
4128         }
4129         if (! $tm) {
4130             $tm .= 'a';
4131         }
4132         my $log_link;
4133         my $pass = param('pass');
4134         my $sort = param('sort');
4135         my $mode2 = param('mode2');
4136         my %param = ('mode'=>'admin','login_admin'=>$login_admin,'sort'=>$sort,'mode2'=>$mode2,'line'=>$count);
4137         if (param('show_log') && param('line') == $count) {
4138             $log_link = qq($script?mode=admin&amp;login_admin=) . param('login_admin') . qq(&amp;sort=) . param('sort') . qq(&amp;mode2=) . param('mode2') . qq(&amp;line=$count#line$count);
4139         } else {
4140             $log_link = qq($script?mode=admin&amp;login_admin=) . param('login_admin') . qq(&amp;sort=) . param('sort') . qq(&amp;mode2=) . param('mode2') . qq(&amp;show_log=$tm&amp;line=$count#line$count);
4141             $param{'show_log'} = $tm;
4142         }
4143         my ($html2, $rowspan);
4144         if (param('show_log') && param('line') == $count && open(LOG,join('/',$access_dir,param('show_log') . '.cgi'))) {
4145             my @log = <LOG>;
4146             close(LOG);
4147             @log =reverse @log;
4148             $rowspan = scalar(@log);
4149             my $sub = 0;
4150             foreach (@log) {
4151                 my ($name,$ax_tm,$host,$reg_tm) = split(/\,/);
4152                 $name = &rechange($name);
4153                 $ax_tm =~ s/(\(日\))/<span style="color:red">$1<\/span>/;
4154                 $ax_tm =~ s/(\(土\))/<span style="color:blue">$1<\/span>/;
4155                 if (! $sub) {
4156                     $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);
4157                 } else {
4158                     $html2 .= qq(<tr><td><small>$ax_tm</small></td><td><small>$host</small></td></tr>\n);
4159                 }
4160                 $sub++;
4161             }
4162         }
4163         $html .= qq(<tr><td><a name="line$count" id="line$count">$ac_user</a></td>);
4164         if ($post_only) {
4165             $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);
4166         } else {
4167             $html .= qq(<td><small><a href="$log_link" style="padding:0.2em">$ac_time</a></small></td>\n);
4168         }
4169         $html .= qq(<td><small>$ac_host</small></td></tr>\n);
4170         $html .= $html2;
4171         $count++;
4172     }
4173     $html .= qq(</table>\n);
4174 }
4175 
4176 
4177 sub show_del_file {
4178     my @del_file_list = &read_file('./delete.log');
4179     my $html;
4180     $html .= qq(<table border="1" cellspacing="0" summary="自動削除されたファイル">\n);
4181     $html .= qq(<caption>自動削除されたファイル</caption>);
4182     $html .= qq(<tr><th>削除した日時</th><th>ディレクトリ</th><th>ファイル名</th></tr>\n);
4183     @del_file_list = reverse @del_file_list;
4184     foreach (@del_file_list) {
4185         my ($tm,$path) = split(/<>/);
4186         $path =~ s/([^\/]*)$//;
4187         my $file = &url_decode($1);
4188         chomp $file;
4189         my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($tm);
4190         my @youbi = ("日", "月", "火", "水", "木", "金", "土");
4191         $wday = $youbi[$wday];
4192         $year += 1900;
4193         $month++;
4194         my($time) = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
4195         if ($file =~ /_count$/) {
4196             $html .= qq(<tr style="color:#999999"><td><span style="font-size:80%">) . $time . "</span></td><td>" . $path . "</td><td>$file</td></tr>\n";
4197         } else {
4198             $html .= qq(<tr><td><span style="font-size:80%">) . $time . "</span></td><td>" . $path . "</td><td>$file</td></tr>\n";
4199         }
4200     }
4201     $html .= qq(</table>\n);
4202     return $html
4203 }
4204 
4205 
4206 sub file_manage {
4207     if (param('show_del_file')) {
4208         my $html = &show_del_file;
4209         return $html;
4210     }
4211     @up_file_list = ();
4212     my $html;
4213     &file_list($root);
4214     my (@d, $d);
4215     foreach (@up_file_list) {
4216         /([^\/]*)$/;
4217         if (! param('show_all')) {
4218             next if $1 eq 'index.html' || $1 eq '.htaccess' || $1 =~ /_count$/;
4219         }
4220         @d = $_ =~ /\//g;
4221         $d = scalar(@d) if $d < scalar(@d);
4222     }
4223     my %comment;
4224 
4225     # ファイルを「削除する」ボタンを押したら
4226     if (param('del_old') || param('file_delete')) {
4227         my $del_day = param('del_day');
4228         $del_day = $life if ! $del_day;
4229         foreach (@up_file_list) {
4230             if (param("$_")) {
4231                 if (unlink $_) {
4232                     push(@del_list,$_);
4233                     if (-e $_ . '_count') {
4234                         unlink($_ . '_count');
4235                     }
4236                 }
4237             }
4238         }
4239         &delete_old($updir,$del_day);
4240         if (@del_list) {
4241             $comment{'del_file'} .= qq(<span style="color:red">);
4242             foreach (@del_list) {
4243                 $comment{'del_file'} .= qq(<strong>) . &url_decode($_) . qq(</strong>を削除しました。<br />\n);
4244             }
4245             $comment{'del_file'} .= qq(</span>\n);
4246             if ($delete_log ) { &delete_log(@del_list); }
4247         } else {
4248             $comment{'del_file'} .= qq(<span style="color:red">削除するファイルはありません。</span>);
4249         }
4250         @up_file_list = ();
4251         &file_list($root);
4252     }
4253     $html .= $comment{'del_file'} if $comment{'del_file'};
4254     $html .= qq(<table summary="一括削除フォーム">\n);
4255     $html .= qq(<tr><td colspan="2">);
4256     $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);
4257     $html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
4258     $html .= qq(アップロードから<input type="text" name="del_day" value="${life}" size="2" style="ime-mode:disabled" />);
4259     $html .= qq(日以上経過したファイルを<input type="submit" name="del_old" value="削除する" style="margin:0" />);
4260     $html .= qq(</form>\n);
4261     $html .= qq(</td>);
4262     if (-e './delete.log') {
4263         my %param = ('mode'=>'admin','mode2'=>'file_manage','show_del_file'=>'1','login_admin'=>$login_admin);
4264         if ($post_only) {
4265             $html .= qq(<td><form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="自動削除されたファイル" /></form></td>);
4266         } else {
4267             $html .= qq(<td>&nbsp;&nbsp;<a href="$script) . &url_param(%param) . qq(">自動削除されたファイル</a></td>);
4268         }
4269     }
4270     $html .= qq(</tr>\n</table>\n);
4271     my $form2;
4272     my $show_all = param('show_all');
4273     my %param = ('mode'=>'admin','mode2'=>'file_manage','login_admin'=>$login_admin,'show_all'=>$show_all);
4274     my $reload;
4275     if ($post_only) {
4276         $reload = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="image" src="./img/reload.gif" alt="リロード" /><input type="submit" value="リロード" /></form>);
4277     } else {
4278         $reload = qq(&nbsp;<a href="$script) . &url_param(%param) . qq(">リロード</a>);
4279     }
4280     undef $show_all;
4281     if (param('show_all')) {
4282         $param{'show_all'} = 0;
4283         if ($post_only) {
4284             $show_all = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="隠しファイルを隠す" /></form>);
4285         } else {
4286             $show_all = qq(&nbsp;<a href="$script) . &url_param(%param) . qq(">隠しファイルを隠す</a>);
4287         }
4288     } else {
4289         $param{'show_all'} = 1;
4290         if ($post_only) {
4291             $show_all = qq(<form action="$script" method="post" style="margin:0;padding:0">) . &hidden_param(%param) . qq(<input type="submit" value="隠しファイルも表\示" /></form>);
4292         } else {
4293             $show_all = qq(&nbsp;<a href="$script) . &url_param(%param) . qq(">隠しファイルも表\示</a>);
4294         }
4295     }
4296     $form2 .= qq(<table summary="ファイル一覧メニュー"><tr><td>ファイル一覧</td><td>$reload</td><td>$show_all</td></tr></table>\n);
4297     $form2 .= qq(<table summary="個別削除フォーム" border="1" cellpadding="1" cellspacing="0">\n);
4298     my ($tree, @last);
4299     foreach (@up_file_list) {
4300         /([^\/]*)$/;
4301         if (! param('show_all')) {
4302             next if $1 eq 'index.html' || $1 eq '.htaccess' || $1 =~ /_count$/;
4303         }
4304         $tree .= qq(<tr>);
4305         my @path = split(/\//);
4306         for (my $i = 1; $i <= $d; $i++) {
4307             if ($path[$i] ne $last[$i]) {
4308                 $last[$i] = $path[$i];
4309                 if ($i == scalar(@path) - 1) {
4310                     my $colspan = $d - $i + 1;
4311                     my $img = &icon($_);
4312                     my $file = my $dir = $_;
4313                     $file =~ /([^\\\/]+)$/;
4314                     $file = $1;
4315                     $file =~ s/%/%25/g;
4316                     $dir =~ s/\/[^\/]*$//;
4317                     $tree .= qq(<td colspan="$colspan" style="text-align:right;">\n);
4318                     my %param = ('mode'=>'download','login_admin'=>$login_admin,'dir'=>$dir,'file'=>$file);
4319                     if ($post_only) {
4320                         $tree .= qq(<table summary="ファイルを開く"><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(を開く" /></form></td><td>) . &url_decode($path[$i]) . qq(</td></tr></table>\n);
4321                     } else {
4322                         $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>);
4323                     }
4324                     $tree .= qq(</td>\n);
4325                     last;
4326                 } else {
4327                     my $dir = $_;
4328                     for (my $j=$i; $j < (scalar(@path) - 1); $j++) {
4329                         $dir =~ s/\/[^\/]*$//;
4330                     }
4331                     my %param = ('login_admin'=>$login_admin,'dir'=>$dir);
4332                     if ($post_only) {
4333                         $tree .= qq(<td><table summary="ディレクトリに移動"><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]ディレクトリに移動" /></form></td><td>$path[$i]</td></tr></table></td>\n);
4334                     } else {
4335                         $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);
4336                     }
4337                 }
4338             } else {
4339                 if ($i == scalar(@path) - 1) {
4340                     my $colspan = $d - $i + 1;
4341                     my $img = &icon($_);
4342                     my $file = $_;
4343                     $file =~ s/%/%25/g;
4344                     my %param = ('mode'=>'download','login_admin'=>$login_admin,'file'=>$file);
4345                     if ($post_only) {
4346                         $tree .= qq(<td colspan="$colspan" style="text-align:right;"><table summary="ファイルを開く"><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(を開く" /></form></td><td>) . &url_decode($path[$i]) . qq(</td></tr></table></td>);
4347                     } else {
4348                         $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);
4349                     }
4350                     last;
4351                 } else {
4352                     $tree .= qq(<td>&nbsp;</td>\n);
4353                 }
4354             }
4355         }
4356         my $size = (stat($_))[7];
4357         my $mod = (stat($_))[9];
4358         my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($mod);
4359         my @youbi = ("日", "月", "火", "水", "木", "金", "土");
4360         $wday = $youbi[$wday];
4361         $year += 1900;
4362         $month++;
4363         my($time) = sprintf("%04d/%02d/%02d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
4364         my %param = ('mode'=>'admin','mode2'=>'file_manage','login_admin'=>$login_admin,'file_delete'=>'1');
4365         $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);
4366         $tree .= qq(<td style="text-align:right;"><span style="font-size:80%">) . &kiro_byte($size) . qq(</span></td>);
4367         $tree .= qq(<td><span style="font-size:80%"><a title="$_">$time</a></span></td>);
4368         $tree .= qq(</tr>\n);
4369     }
4370     if ($tree) {
4371         $html .= $form2 . $tree . qq(</table>\n);
4372     }
4373     return $html;
4374 }
4375 
4376 sub file_list {
4377     my $dir = shift;
4378     my @dir_list;
4379     opendir(DIR,$dir) or return($!);
4380     while (my $file = readdir(DIR)) {
4381         next if $file eq '.' || $file eq '..';
4382         my $path = join('/',$dir,$file);
4383         if (-f $path) {
4384             push(@up_file_list,$path);
4385         } elsif (-d $path) {
4386             push(@dir_list,$path);
4387         }
4388     }
4389     closedir(DIR);
4390     foreach (@dir_list) {
4391         &file_list("$_");
4392     }
4393 }
4394 
4395 
4396 sub dir_arrange {
4397     @dir_list = ();
4398     my $html;
4399     &get_subdir($root);
4400     my $form;
4401     my $tab_indx = 2;
4402     my $no_user_dir;
4403     foreach my $dir (@dir_list) {
4404         next if $dir eq './upload/usr_root' || $dir eq './upload/root';
4405         my $usr_exs = 0;
4406         my $own;
4407         my @own;
4408         foreach (@user) {
4409             my $usr_dir = (split(/\,/))[2];
4410             if ($dir =~ /^$usr_dir$/ || $dir =~ /^$usr_dir\//) {
4411                 $usr_exs = 1;
4412                 $own .= (split(/\,/))[1];
4413                 push(@own,(split(/\,/))[1]);
4414             }
4415         }
4416         if (! $usr_exs) {
4417             if (param('deldir_' . $dir) eq '削除' || param('del_all')) {
4418                 if (! &delete_dir($dir)) {
4419                     $form .= qq(<tr><td colspan="3"><span style="color:red"><strong>${dir}</strong>を削除しました</span></td></tr>\n);
4420                 }
4421             } else {
4422                 if (! -d $dir) {
4423                     $form .= qq(<tr><td colspan="3"><span style="color:red">$dir</span></td></tr>\n);
4424                 } else {
4425                     my %param = ('login_admin'=>$login_admin,'dir'=>$dir);
4426                     if ($post_only) {
4427                         $form .= qq(<tr><td><table summary="ディレクトリを移動"><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);
4428                     } else {
4429                         $form .= qq(<tr><td><a href="$script) . &url_param(%param) . qq(" title="${dir}に移動">$dir</a>&nbsp;</td>\n);
4430                     }
4431                     undef %param;
4432                     %param = ('del_dir'=>'1','mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'dir_arrange');
4433                     $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);
4434                     $file_nmb = 0;
4435                     $dir_nmb = 0;
4436                     my $size = &kiro_byte(&size_measure($dir));
4437                     $form .= qq(<td><span style="font-size:80%">\($size\)&nbsp;ファイル$file_nmb個&nbsp;ディレクトリ$dir_nmb個</span></td></tr>\n);    $tab_indx++;
4438                     $no_user_dir = 1;
4439                 }
4440             }
4441         }
4442     }
4443     if ($no_user_dir) {
4444         $html .= qq(<div>以下のディレクトリはアクセスできるユーザーがいません。削除しますか?</div>\n);
4445     } else {
4446         $html .= qq(<div>使用されていないディレクトリはありません</div>\n);
4447     }
4448     my %param = ('del_dir'=>1,'mode'=>'admin','login_admin'=>$login_admin,'mode2'=>'dir_arrange');
4449     $html .= qq(<form action="$script" method="post">\n);
4450     $html .= &hidden_param(%param);
4451     $html .= qq(<input type="submit" name="del_all" value="全て削除" tabindex="$tab_indx" />&nbsp;);
4452     $html .= qq(<input type="submit" value="リロード" tabindex="1" />\n);
4453     $html .= qq(</form>\n);
4454     if ($form) {
4455         $html .= qq(<table border="1" cellspacing="0" summary="ディレクトリ削除フォーム">\n);
4456         $html .= $form;
4457         $html .= qq(</table>\n);
4458     }
4459     return $html;
4460 }
4461 
4462 
4463 sub read_file {
4464     my @log;
4465     my $file_path = $_[0];
4466     if (open(IN,"$file_path")) {
4467         @log = <IN>;
4468         close(IN);
4469     }
4470     return @log;
4471 }
4472 
4473 
4474 sub user {
4475     if (param('cancel')) {
4476         my $jump = $script . qq(?login_user=$login_user);
4477         &redirect($jump);
4478         exit;
4479     }
4480     if (param('do_del')) {
4481         my @new_user = ();
4482         my ($del_dir, $enc_pass);
4483         &lock();
4484         my @user = &read_file('./user.cgi');
4485         foreach (@user) {
4486             my ($time,$name,$dir,$epass) = split(/\,/);
4487             if ($tm{"$id"} != $time || $id ne $name) {
4488                 push(@new_user,$_);
4489             } else {
4490                 $del_dir = $dir;
4491                 $enc_pass = $epass;
4492             }
4493         }
4494         if (param('del_dir')) {
4495             &delete_dir($del_dir);
4496             my $pass_file_dir = join('/', $passdir, 'upload/usr_root', $enc_pass);
4497             &delete_dir($pass_file_dir);
4498         }
4499         if (open(USR,">./user.cgi")) {
4500             print USR @new_user;
4501             close(USR);
4502         }
4503         
4504         # 生パスワードも削除しておく
4505         my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
4506         open(RAW,"$raw_pass_path");
4507         my @raw_pass_list = <RAW>;
4508         close(RAW);
4509         open(RAW,">$raw_pass_path");
4510         foreach (@raw_pass_list) {
4511             if ((split(/,/))[0] != $tm{"$id"}) {
4512                 print RAW $_;
4513             }
4514         }
4515         close(RAW);
4516         &unlock();
4517         &set_cookie();    # 削除したらクッキーも消しておく
4518         if ($mail_notify && @admin_mail) {
4519             my ($mail_title, @msg, $msg);
4520             $mail_title = '【' . $simple_title . '】' . $id . "${mr}登録抹消";
4521             my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
4522             $year+=1900;
4523             $mon++;
4524             my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
4525             @msg = &read_file('./mail_template/u2a_del.txt');
4526             $msg = join('',@msg);
4527             my $url = url;
4528             $msg =~ s/<date>/$tm_com/g;
4529             $msg =~ s/<title>/$simple_title/g;
4530             $msg =~ s/<user>/$id/g;
4531             $msg =~ s/<mr>/$mr/g;
4532             $msg =~ s/<url>/$url/g;
4533             foreach (@admin_mail) {
4534                 &notify($mail_title, $msg, $_);
4535             }
4536         }
4537         my $jump = qq($script?message=) . &url_encode(qq(<strong>${id}</strong>の登録を削除しました。));
4538         &redirect($jump);
4539         exit;
4540     }
4541     $title .= qq(ユーザー設定画面);
4542     if (param('chg_do')) {
4543         if ($use_htaccess && param('new_id') =~ /:/) {
4544             &error('ユーザー名エラー','ユーザー名に:(コロン)は使わないでください。');
4545         }
4546         if (length(param('new_id')) > $max_user_id) {
4547             &error('ユーザー名エラー',"ユーザー名は半角で${max_user_id}文字、全角で" . (int($max_user_id / 2)) . '文字以内にしてください。');
4548         }
4549         if (param('new_pass') && length(param('new_pass')) < $pass_length) { &error('エラー',"パスワードは${pass_length}文字以上にしてください"); }
4550         if ($chk_mail) {
4551             require './email_chk.pl';
4552             if (param('new_mail') && ! &email_chk(param('new_mail'))) { &error('エラー',"メールアドレスの書式が正しくありません。"); }
4553         }
4554         my @new_user = ();
4555         my ($comment, $tmp_id, $tmp_pass);
4556         &lock();
4557         my @user = &read_file('./user.cgi');
4558         foreach (@user) {
4559             my ($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail) = split(/\,/);
4560             if ($tm{"$id"} != $time) {
4561                 push(@new_user,$_);
4562             } else {
4563                 if (param('new_id') ne param('old_id')) {
4564                     $name = param('new_id');
4565                     $comment .= qq(ユーザー名を<strong>) . param('new_id') . qq(</strong>に変更しました。) . "<br />";
4566                     $tmp_id = param('new_id');
4567                     my $tmp_dir = $dir;
4568                     $tmp_dir =~ s/^\.\///;
4569                     my $pass_file_path = join('/', $passdir, $tmp_dir, '.htpasswd');    # パスワードファイルのパス
4570                     if (open(PAS,"$pass_file_path")) {
4571                         my @pass_list = <PAS>;
4572                         close(PAS);
4573                         my @new_pass_list = ();
4574                         foreach (@pass_list) {
4575                             my ($name,$pass) = split(/:/);
4576                             if ($name eq param('old_id')) {
4577                                 push(@new_pass_list, param('new_id') . qq(:$epass\n));
4578                             } else {
4579                                 push(@new_pass_list,$_);
4580                             }
4581                         }
4582                         open(PAS,">$pass_file_path");
4583                         print PAS @new_pass_list;
4584                         close(PAS);
4585                     }
4586                     open(LGI,">" . join('/',$logindir,$ENV{'REMOTE_ADDR'} . $login_user . '.cgi'));
4587                     print LGI $tmp_id;
4588                     close(LGI);
4589                 }
4590                 my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
4591                 my (@raw_pass_list, @new_raw_pass_list, $pass_e);
4592                 if (open(RAW,"$raw_pass_path")) {
4593                     @raw_pass_list = <RAW>;
4594                     close(RAW);
4595                 }
4596                 my $rewrite = 1;    # 生パスワードが保存されていない場合、保存し直す。ファイルがダウンロードできない状態を復旧するため。
4597                 foreach (@raw_pass_list) {
4598                     my ($tm,$raw_pass) = split(/,/);
4599                     chomp $raw_pass;
4600                     if ($tm == $tm{"$id"}) {
4601                         if ($raw_pass) {
4602                             $rewrite = 0;
4603                         }
4604                     }
4605                 }
4606                 # $rewriteがtrueの場合も生パスワードを保存するように変更(ver.1.8)
4607                 if (param('new_pass') ne param('old_pass') || $rewrite) {
4608                     my $new_raw_pass = param('new_pass');
4609                     $epass = &encrypt($new_raw_pass);
4610                     foreach (@raw_pass_list) {
4611                         my ($tm,$raw_pass) = split(/,/);
4612                         if ($tm == $tm{"$id"}) {
4613                             my $e_new_raw_pass = &change($new_raw_pass);
4614                             push(@new_raw_pass_list,qq($tm,$e_new_raw_pass,\n));
4615                             $pass_e = 1;
4616                         } else {
4617                             push(@new_raw_pass_list,$_);
4618                         }
4619                     }
4620                     if (! $pass_e) {
4621                         my $e_new_raw_pass = &change($new_raw_pass);
4622                         push(@new_raw_pass_list,qq($tm{"$id"},$e_new_raw_pass,\n));
4623                     }
4624                     open(RAW,">$raw_pass_path");
4625                     print RAW @new_raw_pass_list;
4626                     close(RAW);
4627                     my $tmp_dir = $dir;
4628                     $tmp_dir =~ s/^\.\///;
4629                     my $pass_file_path = join('/', $passdir, $tmp_dir, '.htpasswd');    # パスワードファイルのパス
4630                     if (open(PAS,"$pass_file_path")) {
4631                         my @pass_list = <PAS>;
4632                         close(PAS);
4633                         my @new_pass_list = ();
4634                         foreach (@pass_list) {
4635                             my ($name,$pass) = split(/:/);
4636                             if ($name eq param('old_id')) {
4637                                 push(@new_pass_list, param('new_id') . qq(:$epass\n));
4638                             } else {
4639                                 push(@new_pass_list,$_);
4640                             }
4641                         }
4642                         open(PAS,">$pass_file_path");
4643                         print PAS @new_pass_list;
4644                         close(PAS);
4645                     }
4646                     $comment .= qq(パスワードを<strong>) . param('new_pass') . qq(</strong>に変更しました。) . "<br />";
4647                     $tmp_pass = param('new_pass');
4648                 }
4649                 if (param('new_mail') ne param('old_mail')) {
4650                     $email = param('new_mail');
4651                     $comment .= qq(メールアドレスを<strong>) . param('new_mail') . qq(</strong>に変更しました。) . "<br />";
4652                 }
4653                 $dlmail = param('dlmail');
4654                 if (param('max_day') != $max_day{"$id"}) {
4655                     $comment .= qq(ファイル保存日数を<strong>) . param('max_day') . qq(日</strong>に変更しました。) . "<br />";
4656                 }
4657                 if (param('max_down') != $max_down{"$id"}) {
4658                     $comment .= qq(ダウンロード回数上限を<strong>) . param('max_down') . qq(回</strong>に変更しました。) . "<br />";
4659                 }
4660                 if (param('dlmail') != $dlmail{"$id"}) {
4661                     if (param('dlmail')) {
4662                         $comment .= qq(ゲストがファイルをダウンロードしたらメールで知らせるよう設定しました。) . "<br />";
4663                     } else {
4664                         $comment .= qq(ゲストがファイルをダウンロードした際のメール通知を無効に設定しました。) . "<br />";
4665                     }
4666                 }
4667                 $name = &change($name);
4668                 $max_day = param('max_day') if param('max_day');
4669                 $max_down = param('max_down') if param('max_down');
4670                 push(@new_user,qq($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail,\n));
4671             }
4672         }
4673         if (open(USR,">./user.cgi")) {
4674             print USR @new_user;
4675             close(USR);
4676         }
4677         &unlock();
4678         if ($mail_notify && @admin_mail) {
4679             my ($mail_title, @msg, $msg);
4680             $mail_title = '【' . $simple_title . '】' . $id . "${mr}登録変更";
4681             my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
4682             $year+=1900;
4683             $mon++;
4684             my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
4685             @msg = &read_file('./mail_template/u2a_mod.txt');
4686             $msg = join('',@msg);
4687             my $url = url;
4688             my $change = '';
4689             if (param('new_id') ne param('old_id')) {
4690                 $change .= qq(ユーザー名 : ) . param('old_id') . qq( → ) . param('new_id') . qq(\n);
4691             }
4692             if (param('new_pass') ne param('old_pass')) {
4693 #                $change .= qq(パスワード : ) . param('old_pass') . qq( → ) . param('new_pass') . qq(\n);
4694                 $change .= qq(パスワード : ) . "******" . qq( → ) . "******" . qq(\n);    # パスワードは表示しない
4695             }
4696             if (param('new_mail') ne param('old_mail')) {
4697                 $change .= qq(メールアドレス : ) . param('old_mail') . qq( → ) . param('new_mail') . qq(\n);
4698             }
4699             $msg =~ s/<date>/$tm_com/g;
4700             $msg =~ s/<title>/$simple_title/g;
4701             $msg =~ s/<user>/$id/g;
4702             $msg =~ s/<mr>/$mr/g;
4703             $msg =~ s/<url>/$url/g;
4704             $msg =~ s/<change>/$change/g;
4705             # 変更があった場合だけメール送信
4706             if ($change) {
4707                 foreach (@admin_mail) {
4708                     &notify($mail_title, $msg, $_);
4709                 }
4710             }
4711         }
4712         $id = $tmp_id if $tmp_id;
4713         $pass = $tmp_pass if $tmp_pass;
4714         &set_cookie($id,$pass,param('save_cook'));
4715         $comment = qq(何も変更されていません。<br />) if ! $comment;
4716         my $jump = qq($script?mode=user&id=) . &url_encode($id) . qq(&login_user=$login_user&comment=) . &url_encode($comment);
4717         &redirect($jump);
4718     }
4719     &header;
4720     if (param('del_regist')) {
4721         my %param = ('login_user'=>$login_user,'mode'=>'user');
4722         my $hidden = &hidden_param(%param);
4723         print <<"EOM";
4724 <div style="text-align:center;">
4725 <strong>$id</strong>の登録を削除しますか
4726 <form action="$script" method="post">
4727 $hidden
4728 <input type="submit" name="do_del" value="削除する" tabindex="1" />
4729 <input type="submit" name="cancel" value="キャンセル" tabindex="2" />
4730 <br /><input type="checkbox" name="del_dir" id="del_dir" checked="checked" value="1" tabindex="3" />&nbsp;<label for="del_dir">専用ディレクトリを削除する</label>
4731 </form>
4732 </div>
4733 EOM
4734         &footer;
4735         return;
4736     }
4737     my ($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail);
4738     foreach (@user) {
4739         ($time,$name,$dir,$epass,$perm,$size,$email,$max_day,$max_down,$dlmail) = split(/\,/);
4740         if ($tm{"$id"} == $time) {
4741             last;
4742         }
4743     }
4744     chomp $dlmail;
4745     my ($cid,$cpass,$cuse_cook) = &get_cookie;
4746     my ($chk, $dlm_chk);
4747     if ($cuse_cook) {
4748         $chk = qq( checked="checked");
4749     } else {
4750         $chk = '';
4751     }
4752     if ($dlmail) {
4753         $dlm_chk = qq( checked="checked");
4754     } else {
4755         $dlm_chk = '';
4756     }
4757     my ($auto_pass,$auto_pass_com,$hidden) = &auto_pass_frm(6);
4758     my $pass = param('pass');
4759     my $old_id = $id;
4760     my $old_pass = my $new_pass = $pass;
4761     $new_pass = $auto_pass if $auto_pass;
4762     my $old_mail = $mail{"$id"};
4763     my $comment = qq(<span style="color:red">) . param('comment') . qq(</span>) if param('comment');
4764     my $cancel_button = 'キャンセル';
4765     $cancel_button = '戻る' if $comment;
4766     my $max_day_op = qq(<select name="max_day">\n);
4767     for(my $count=$auto_delete;$count>=1;$count--) {
4768         chomp $max_day{"$id"};
4769         $max_day{"$id"} = 0 if ! $max_day{"$id"};
4770         if ($max_day{"$id"} == $count || (!$max_day{"$id"} && $count == $auto_delete)) {
4771             $max_day_op .= qq(<option value="$count" selected="selected">${count}日</option>\n);
4772         } else {
4773             $max_day_op .= qq(<option value="$count">${count}日</option>\n);
4774         }
4775     }
4776     $max_day_op .= qq(</select>\n);
4777     my $max_down_op = qq(<select name="max_down">);
4778     for(my $count=$max_dl_count;$count>=1;$count--) {
4779         if ($max_down{"$id"} == $count || (!$max_down{"$id"} && $count == $max_dl_count)) {
4780             $max_down_op .= qq(<option value="$count" selected="selected">${count}回</option>\n);
4781         } else {
4782             $max_down_op .= qq(<option value="$count">${count}回</option>\n);
4783         }
4784     }
4785     $max_down_op .= qq(</select>\n);
4786     my $dlmail_form;
4787     if ($send_dlmail && $email) {
4788         $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">ファイルがダウンロードされたらメールで知らせる</label></td></tr>);
4789     }
4790     my $width1 = 120;
4791     if (length($id) > 20) {
4792         $width1 = length($id) * 6;
4793     }
4794     my %param = ('mode'=>'user','login_user'=>$login_user,'old_id'=>$id,'old_pass'=>$pass,'old_mail'=>$mail{"$id"});
4795     $hidden = &hidden_param(%param) . $hidden;
4796     print <<"EOF";
4797 <div style="text-align:center;margin:1em">
4798 $comment
4799 変更する部分のみ修正して「変更」ボタンを押してください&nbsp;&nbsp;<a href="userconfig_help.html" target="_blank"><img src="./img/quest.gif" style="border:0" alt="ヘルプ" />ヘルプ</a>
4800 <form action="$script" method="post">
4801 $hidden
4802 <table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="新規登録フォーム">
4803 <tr><td colspan="2" style="text-align:center;"><input type="submit" name="chg_do" value="変 更" tabindex="1" />&nbsp;&nbsp;<input type="reset" tabindex="2" />&nbsp;&nbsp;<input type="submit" name="cancel" value="$cancel_button" tabindex="3" /></td></tr>
4804 <tr><td style="text-align:right;">ユーザー名<span style="color:red;font-size:80%">※必須</span></td><td align="left"><input type="text" name="new_id" value="$id" style="width:${width1}px;height:16px" tabindex="4" /></td></tr>
4805 <tr><td style="text-align:right;">パスワード<span style="color:red;font-size:80%">※必須</span></td><td align="left"><input type="text" name="new_pass" value="$new_pass" style="width:120px;height:16px" tabindex="5" />
4806 <span style="color:red;font-size:80%">変更する場合だけ記入してください</span></td></tr>
4807 $auto_pass_com
4808 <tr><td colspan="2" style="text-align:right;"><span style="font-size:80%">※パスワードに</span>&nbsp;<span style="font-weight:bold;font-size:120%">$ban</span>&nbsp;<span style="font-size:80%">は使用しないでください</span></td></tr>
4809 <tr><td style="text-align:right;">メールアドレス</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>
4810 <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">クッキーを使用する</label></td></tr>
4811 $dlmail_form
4812 <tr><td style="text-align:right;">ファイル保存日数</td><td style="text-align:left;">$max_day_op<span style="font-size:80%">(ゲストの有効期限デフォルト)</span></td></tr>
4813 <tr><td style="text-align:right;">ダウンロード回数上限</td><td style="text-align:left;">$max_down_op<span style="font-size:80%">(これを過ぎるとファイルを削除)</span></td></tr>
4814 </table>
4815 <table style="margin:auto;margin-top:2em">
4816 <tr><td colspan="2" style="text-align:center;"><input type="submit" name="del_regist" value="登録を削除する" style="margin:4px" tabindex="9" /></td></tr>
4817 </table>
4818 </form>
4819 </div>
4820 EOF
4821     &footer;
4822 }
4823 
4824 
4825 sub redirect {
4826     if ($ENV{PERLXS} eq "PerlIS") {
4827         print "HTTP/1.0 302 Temporary Redirection\r\n";
4828         print "Content-type: text/html\n";
4829     }
4830     print "Location: $_[0]" ."\n\n";
4831     exit;
4832 }
4833 
4834 
4835 sub jump {
4836     my $param = $_[0];
4837     my %param = %$param;
4838     if ($header_flag) { return; }
4839     my $nohead = $_[0];
4840     $header_flag = 1;
4841     print "Content-type: text/html\n\n";
4842     print <<"EOM";
4843 <?xml version="1.0" encoding="Shift_JIS"?>
4844 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
4845 <html xmlns="http://www.w3.org/1999/xhtml" lang="ja" xml:lang="ja">
4846 <head>
4847 <meta http-equiv="content-type" content="text/html; charset=Shift_JIS" />
4848 <meta http-equiv="content-style-type" content="text/css" />
4849 <meta http-equiv="content-script-type" content="text/javascript" />
4850 <meta name="description" content="マルチアップローダ" />
4851 <meta name="keywords" content="キーワードを入れる" />
4852 <title>$title</title>
4853 <link rel="shortcut icon" href="./favicon.ico" />
4854 <link rel="stylesheet" href="./style.css" type="text/css" />
4855 </head>
4856 <body onLoad="document.f.submit()";>
4857 EOM
4858     print &headline;
4859     print qq(<form action="$script" name=f method="post">\n);
4860     foreach (keys %param) {
4861         print qq(<input type="hidden" name="$_" value=") . &url_decode($param{$_}) . qq(" />\n);
4862     }
4863     print qq(</form>\n);
4864     print qq(</body></html>);
4865 }
4866 
4867 sub config {
4868     my $do_word = shift;
4869     my $tindx = shift;
4870     if (! open(SCR,"$script")) {
4871         return;
4872     }
4873     my @scr = <SCR>;
4874     close(SCR);
4875     my ($comment, $chg_use_htaccess, $chg_passdir);
4876     if (&url_decode(param('config')) eq $do_word) {
4877         my @new_scr = ();
4878         my @config_value = ();
4879         push(@config_value,qq(adminpass<>$adminpass\n));
4880         push(@config_value,qq(passdir<>$passdir\n));
4881         my ($chg_com,$config_start,$config_end);
4882         foreach my $line (@scr) {
4883             if ($line =~ /^# config_start/) { $config_start = 1; }
4884             if ($line =~ /^# config_end/) { $config_end = 1; }
4885             if ($config_end || ! $config_start) {
4886                 push(@new_scr, $line);
4887                 next;
4888             }
4889             foreach my $cfg (@config) {
4890                 if ($cfg && $line =~ /^\s*(my)?\s*\$$cfg\s*=\s*/) {
4891                     my ($value,$val);
4892                     if (param("$cfg") =~ /^\d+$/) {
4893                         $value = param("$cfg");
4894                     } else {
4895                         $val = param("$cfg");
4896                         $val =~ s/&lt;/</g;
4897                         $val =~ s/&gt;/>/g;
4898                         $val =~ s/&quot;/"/g;
4899                         $val =~ s/\\$//;
4900                         $value = "'" . $val . "'";
4901                     }
4902                     if ($cfg eq 'use_htaccess' && param("$cfg")) {
4903                         $chg_use_htaccess = 1;
4904                     }
4905                     my ($frm,$com) = split(/;/,$line);
4906                     my($var,$oval) = split(/=/,$frm);
4907                     my @oval = split(/=/,$frm);
4908                     shift @oval;
4909                     $oval = join('=',@oval);
4910                     $oval =~ s/\s//;
4911                     $oval =~ s/^['"]//;
4912                     $oval =~ s/['"]$//;
4913                     if ($oval ne param("$cfg")) {
4914                         $chg_com .= qq(<div style="color:red">${frm}&nbsp;→&nbsp;) . 'my $' . $cfg . " = " . $value . qq(</div>\n);
4915                     }
4916                     chomp $com;
4917                     $line = 'my $' . $cfg . " = " . $value . ";" . $com . "\n";
4918                     push(@config_value,qq($cfg<>) . param("$cfg") . qq(\n));
4919                     last;
4920                 }
4921             }
4922             if ($chg_use_htaccess && ! $passdir && $line =~ /^\s*my\s*\$passdir\s*=\s*/) {
4923                 my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
4924                 srand;
4925                 for (1 .. 12) {
4926                     $passdir .= $salt[int(rand(@salt))];
4927                 }
4928                 my $value = qq('$passdir');
4929                 my @tmp = split(/;/,$line);
4930                 my $com = pop(@tmp);
4931                 chomp $com;
4932                 $line = 'my $passdir = ' . $value . ";" . $com . "\n";
4933                 if (! -d $passdir) {
4934                     mkdir $passdir;
4935                 }
4936                 my $index = join('/',$passdir,'index.html');
4937                 if ($make_index && ! -f $index) {
4938                     open(INDX,">$index");
4939                     close(INDX);
4940                 }
4941             }
4942             push(@new_scr, $line);
4943         }
4944 
4945         # 書き込み前にバックアップ作成
4946         open(INIT,">${script}_bck.cgi") || &error('バックアップエラー',"${script}_bck.cgiが開けません。");
4947         print INIT @scr;
4948         close(INIT);
4949 
4950         open(NEW,">$script") || &error('エラー',"${script}が開けません。");
4951         print NEW @new_scr;
4952         close(NEW);
4953         
4954         # 設定だけも保存
4955         open(CFG,">$config_file") || &error('エラー',"${config_file}が開けません。");
4956         print CFG @config_value;
4957         close(CFG);
4958 
4959         @scr = @new_scr;
4960         $comment = qq(<div style="color:blue"><a name="anchor" id="anchor" style="padding:0.5em">スクリプトの設定を編集しました。</a></div>);
4961         $comment .= $chg_com;
4962     }
4963     my $anchor;
4964     if (param('config') ne $do_word) {
4965         $anchor = qq(<a name="anchor" id="anchor">&nbsp;</a>);
4966     }
4967     my $html;
4968     $html .= qq(<strong>このCGIの設置ディレクトリ</strong>:$path<br />\n);
4969     $html .= $comment if $comment;
4970     $html .= qq(<form action="${script}#anchor" method="post" style="margin:0">\n);
4971     $html .= qq(<input type="hidden" name="mode" value="$mode" />\n);
4972     $html .= qq(<input type="hidden" name="mode2" value="config" />\n);
4973     $html .= qq(<input type="hidden" name="login_admin" value="$login_admin" />\n);
4974     $html .= qq(<table border="1" cellspacing="0" cellpadding="4" summary="スクリプトの設定変更フォーム">\n);
4975     $html .= qq(<tr><td colspan="3" align="center"><input type="submit" name="config" value="$do_word" tabindex="$tindx" /></td></tr>\n);    $tindx++;
4976     my %config_val;
4977     foreach my $cfg (@config) {
4978         my (@tmp, $com, %popup, $name, $value, $style, $line, $nk_value);
4979         foreach my $line (@scr) {
4980             if ($line =~ /^\s*#/) { next; }
4981             my $tmp = $line;
4982             $tmp =~ s/</&lt;/g;
4983             if ($line =~ /\s*(my)?\s*\$$cfg\s*=\s*/) {
4984                 @tmp = split(/;/,$line);
4985                 $com = pop(@tmp);
4986                 chomp $com;
4987                 $popup{"$cfg"} = $com;
4988                 ($name, $value) = split(/=/,$tmp[0]);
4989                 my @value = split(/=/,$tmp[0]);
4990                 shift @value;
4991                 $value = join('=',@value);
4992                 $name =~ s/^\s*my\s*[^\$]//;
4993                 $name =~ s/\s*$//;
4994                 $value =~ s/^\s*['"]?//;
4995                 $value =~ s/['"]?\s*$//;
4996                 $config_val{"$cfg"} = $value;
4997                 last;
4998             }
4999         }
5000         if ($value =~ /#[0-9a-f]{6}/) {
5001             $style = qq( style="background-color:$value;color:) . &text_color($value) . qq(;ime-mode:disabled");
5002         } elsif (($value && $value =~ /^[\d\w%]+$/) || $value eq '0') {
5003             $style = qq( style="ime-mode:disabled");
5004         }
5005         $com = "&nbsp;" if ! $com;
5006         if ($cfg eq 'sendmail' && !-e $value) {
5007             $com = qq(<span style="color:red">${value}は存在しません</span>) . $com;
5008         }
5009         if ($cfg eq 'encode_lib' && $value) {
5010             &module_list($_) for grep {$_ ne '.'} @INC;
5011             if (! $mod_list{'Jcode'}) {
5012                 $com = qq(<span style="color:red">Jcode.pmは使えないようです</span>) . $com;
5013             }
5014         }
5015         if ($cfg eq 'mail_notify' && $value && ! $config_val{"admin_mail"}) {
5016             $com = qq(<span style="color:red">管理者のメールアドレスが登録されていません</span>) . $com;
5017         }
5018         $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++;
5019     }
5020     $html .= qq(</table>\n);
5021     $html .= qq(</form>\n);
5022     return $html;
5023 }
5024 
5025 sub module_list {
5026     my ($base, $path) = @_;
5027     (my $mod = $path) =~ s!/!::!g;
5028     opendir DIR, "$base/$path" or return;
5029     my @node = grep {!/^\.\.?$/} readdir DIR;
5030     closedir DIR;
5031     foreach (@node) {
5032         if (/(.+)\.pm$/) { $mod_list{"$mod$1"} = 1 }
5033         elsif (-d "$base/$path$_") { module_list($base, "$path$_/") }
5034     }
5035 }
5036 
5037 # 更新履歴を表示
5038 sub history {
5039     $title .= ' −更新履歴−';
5040     &header;
5041     my @history = split("\n",$history);
5042     my $i = 0;
5043     my $j;
5044     foreach (@history) {
5045         if (!/\s*ver[\.\s]*\d/) {
5046             s/#\s*/<br \/>/;
5047             $history[$j] .= $_;
5048             $history[$i] = '';
5049         } else {
5050             $j = $i;
5051         }
5052         $i++;
5053     }
5054     @history = reverse @history;
5055     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="更新履歴">\n);
5056     my $count;
5057     foreach (@history) {
5058         next if !$_;
5059         s/^#\s*//;
5060         s/\t+/\t/g;
5061         my ($ver,$date,$cont,$cont2,$cont3) = split(/\t/);
5062         if ($count % 2 == 0) {
5063             print qq(<tr>\n);
5064         } else {
5065             print qq(<tr style="background-color:$zebra_back_col">\n);
5066         }
5067         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);
5068         $cont .= qq(<br />) . $cont2 if $cont2;
5069         $cont .= qq(<br />) . $cont3 if $cont3;
5070         print qq(<td>$cont</td>\n);
5071         print qq(</tr>\n);
5072         $count++;
5073     }
5074     print qq(</table>\n</div>\n);
5075     &footer;
5076 }
5077 
5078 
5079 # ディレクトリを作成する。親ディレクトリが無ければ親ディレクトリも作成する
5080 sub make_dir {
5081     my $new_dir = my $par_dir = shift;
5082     if (! mkdir $new_dir) {
5083         $par_dir =~ s/\/[^\/]*$//;
5084         &make_dir($par_dir);
5085         mkdir $new_dir;
5086     } else {
5087         if ($make_index && $new_dir !~ /^$passdir/) {
5088             open(INDEX,">" . join('/',$new_dir,'index.html') );
5089             close(INDEX);
5090         }
5091     }
5092 }
5093 
5094 sub make_passdir {
5095     # $passdirは元々.htaccessのパスワード保存用ディレクトリだったが、ver.1.51以降必須となった生パスワード保存ディレクトリも兼ねるようになったので、.htaccessを使用しない場合でも生成するように変更した(ver.1.79)。
5096     # 旧バージョンを使用し、$passdirが作成されていない環境からのアップデートした場合、ここで強制的に$passdirを作成する(ver.1.8)。
5097     
5098     my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
5099     my $sucs;
5100     for (1 .. 10) {
5101         srand;
5102         for (1 .. 12) {
5103             $passdir .= $salt[int(rand(@salt))];
5104         }
5105         if (mkdir $passdir) {
5106             $sucs = 1;
5107             last;
5108         }
5109     }
5110     if (! $sucs) {
5111         my $message = "パスワード保存ディレクトリを作成できませんでした。";
5112         my $jump = qq($script?message=) . &url_encode($message);
5113         &redirect($jump);
5114         exit;
5115     }
5116     &lock('init');
5117     if (! open(SCR,"$script")) {
5118         &dbg(qq(${script}オープンエラー));
5119         return;
5120     }
5121     my ( $config_start, $config_end);
5122     my @scr = <SCR>;
5123     close(SCR);
5124     my @new_scr = ();
5125     foreach my $line (@scr) {
5126         if ($line =~ /^# config_start/) { $config_start = 1; }
5127         if ($line =~ /^# config_end/) { $config_end = 1; }
5128         if ($config_end || ! $config_start) {
5129             push(@new_scr, $line);
5130             next;
5131         }
5132         if ($line =~ /^\s*(my)?\s*\$passdir\s*=\s*/) {
5133             my ($frm,$com) = split(/;/,$line);
5134             chomp $com;
5135             $line = 'my $passdir = \'' . $passdir . "';" . $com . "\n";
5136         }
5137         push(@new_scr, $line);
5138     }
5139 
5140     # 書き込み前にバックアップ作成
5141     open(INIT,">${script}_bck.cgi") || &error("${script}_bck.cgiが開けません。");
5142     print INIT @scr;
5143     close(INIT);
5144 
5145     open(NEW,">$script") || &error("${script}が開けません。");
5146     print NEW @new_scr;
5147     close(NEW);
5148 
5149     if (open(CFG,"$config_file")) {
5150         @config_value = <CFG>;
5151         close(CFG);
5152     }
5153     foreach (@config_value) {
5154         my ($name,$value) = split(/<>/);
5155         if ($name eq 'passdir') {
5156             $_ = qq(passdir<>$passdir\n);
5157         }
5158     }
5159     open(CFG,">$config_file") || &error("${config_file}が開けません。");
5160     print CFG @config_value;
5161     close(CFG);
5162 
5163     &unlock('init');
5164     
5165     my $message = "パスワード保存ディレクトリを作成しました。";
5166     my $jump = qq($script?message=) . &url_encode($message);
5167     &redirect($jump);
5168     exit;
5169 }
5170 
5171 sub create_pass {
5172     # $in{'pass'}がTrueなら$scriptに管理者用パスワードを書き込む
5173     if ($pass) {
5174         if (length($pass) < $pass_length) {
5175             &error('パスワードエラー',"パスワードは${pass_length}文字以上にしてください。");
5176         }
5177         my $make_passdir = 0;
5178         # .htaccessを使用しない場合でも$passdirを作成することにする(v.1.79)
5179         if (! $passdir) {
5180             my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
5181             srand;
5182             for (1 .. 12) {
5183                 $passdir .= $salt[int(rand(@salt))];
5184             }
5185             $make_passdir = 1;
5186         }
5187         open(INIT,"$script") || &error('エラー',"$scriptが開けません。");
5188         my @init = <INIT>;
5189         close(INIT);
5190         my @new_init = ();
5191         foreach my $line (@init) {
5192             my $tmp = $line;
5193             $tmp =~ s/ //g;
5194             if ($tmp =~ /^(my)?\s*\$adminpass\s*='/) {
5195                 # 入力された管理者用パスワードをcryptして$passに代入する文字列を生成
5196                 my $crypt_pass = &encrypt($pass);
5197                 my @tmp = split(/;/,$line);
5198                 my $com = pop(@tmp);
5199                 my $new_pass = 'my $adminpass = ' . qq(') . $crypt_pass . qq(';) . $com;
5200                 push(@new_init,$new_pass);
5201             } elsif ($make_passdir && $tmp =~ /^(my)?\s*\$passdir\s*='/) {
5202                 my @tmp = split(/;/,$line);
5203                 my $com = pop(@tmp);
5204                 my $new_passdir = 'my $passdir = ' . qq(') . $passdir . qq(';) . $com;
5205                 push(@new_init,$new_passdir);
5206             } else {
5207                 push(@new_init,$line);
5208             }
5209         }
5210         # 書き込み前にバックアップ作成
5211         open(INIT,">${script}_bck.cgi") || &error('エラー',"${script}_bck.cgiが開けません。");
5212         print INIT @init;
5213         close(INIT);
5214         
5215         # 書き込み
5216         open(INIT,">$script") || &error('エラー',"${script}が開けません。");
5217         print INIT @new_init;
5218         close(INIT);
5219         
5220         # パスワード保存ディレクトリが存在しなければ作る
5221         if (! -d $passdir) {
5222             mkdir $passdir;
5223         }
5224         
5225         # とりあえずユーザー名をadminとしてクッキーに保存しておく。
5226         my $id = $admin_id;
5227         &set_cookie($id,$pass,param('save_cook'));
5228         
5229         # リダイレクト
5230         if ($ENV{PERLXS} eq "PerlIS") {
5231             print "HTTP/1.0 302 Temporary Redirection\r\n";
5232             print "Content-type: text/html\n";
5233         }
5234         my $comment = qq(管理者パスワードを設定しました。管理者のユーザー名は<strong>${id}</strong>です。<br />次回のログイン時はこのユーザー名と、設定した管理者パスワードでログインしてください。);
5235         $login_admin = &random_str();
5236         my $logindir = join('/',$passdir,'login');
5237         mkdir $logindir if ! -d $logindir;
5238         my $login_file = $ENV{'REMOTE_ADDR'} . $login_admin . 'admin.cgi';
5239         my $login_path = join('/',$logindir,$login_file);
5240         open(LGI,">$login_path") || die "$!";
5241         print LGI $id;
5242         close(LGI);
5243         print qq(Location: $script?mode=admin&login_admin=$login_admin&comment=) . &url_encode($comment) . qq(\n\n);
5244         exit;
5245     }
5246     &header;
5247     print qq(<div style="text-align:center;margin:1em">);
5248     print qq(<p>管理者用パスワードを設定してください。</p>\n);
5249     print qq(<form action="$script" method="post">\n);
5250     print qq(パスワード&nbsp;<input type="password" name="pass" value="" size="10" />\n);
5251     print qq(<input type="submit" value="登録" />\n);
5252     print qq(</form>\n);
5253     print qq(</div>);
5254     &footer;
5255 }
5256 
5257 sub login {
5258     my $mode = $_[0];
5259     my $comment = $_[1];
5260     $mode = 'login' if ! $mode || $mode eq 'history';
5261     my $html;
5262     if (param('cancel')) {
5263         &redirect($script);
5264         exit;
5265     }
5266     
5267     # 「新規登録する」ボタンを押した場合、登録フォームを表示
5268     if (param('usr_regist')) {
5269         $title .= ' −新規登録−';
5270         # ユーザー名、パスワードを入力して「登録」ボタンを押した場合、登録処理を行う
5271         if (param('new_id') && param('new_pass') && ! param('auto_pass') && ! param('use_pass')) {
5272             if (length(param('new_pass')) < $pass_length) {
5273                 &error('パスワードエラー',"パスワードは${pass_length}文字以上にしてください");
5274             }
5275             if (param('new_id') eq $admin_id) {
5276                 &error('ユーザー名エラー',"ユーザー名に${admin_id}は使用できません。他の名前にしてください");
5277             }
5278             if (length(param('new_id')) > $max_user_id) {
5279                 &error('ユーザー名エラー',"ユーザー名は半角で${max_user_id}文字、全角で" . (int($max_user_id / 2)) . '文字以内にしてください。');
5280             }
5281             if ($use_htaccess && param('new_id') =~ /:/) {
5282                 &error('ユーザー名エラー','ユーザー名に:(コロン)は使わないでください。');
5283             }
5284             &lock();
5285             open(USR,"./user.cgi");
5286             my @user = <USR>;
5287             close(USR);
5288             foreach (@user) {
5289                 my ($tm, $user, $path, $e_pass, $permit, $l_size) = split(/\,/);
5290                 $user = &rechange($user);
5291                 if ($user eq param('new_id')) {
5292                     &error(qq(${user}はすでに登録済みです。),qq(申\し訳ありませんがユーザー名を変更してください。));
5293                 }
5294             }
5295             if ($user_mail_neces && ! param('new_mail')) {
5296                 &error("メールアドレスが未記入です。","メールアドレスは必須となっています。メールアドレスを記入の上、もう一度登録してください。");
5297             }
5298             if ($chk_mail) {
5299                 require './email_chk.pl';
5300                 if (param('new_mail') && ! &email_chk(param('new_mail'))) { &error('エラー',"メールアドレスの書式が正しくありません。"); }
5301             }
5302             if (! -d $user_root) {
5303                 mkdir $user_root;
5304             }
5305             my $index = join('/',$user_root,'index.html');
5306             if ($make_index && ! -f $index) {
5307                 open(INDX,">$index");
5308                 close(INDX);
5309             }
5310             my $mkd_suc = 0;
5311             my $enc_pass;
5312             for (my $mkd=1; $mkd<=5; $mkd++) {
5313                 $enc_pass = &encrypt(param('new_pass'));
5314                 if ($enc_pass =~ /\// || $enc_pass =~ /\./) {
5315                     # ディレクトリ名に/や.が入っているとエラーになる場合があるのでやり直す
5316                     next;
5317                 }
5318                 # 暗号化したパスワードをディレクトリ名に流用しているが、MD5で暗号化した場合は$enc_passがかなり長くなってしまうので、13文字に切り詰める
5319                 $path = join('/',$user_root,substr($enc_pass,0,13));
5320                 if (mkdir $path) {
5321                     $mkd_suc = 1;
5322                     my $index = join('/',$path,'index.html');
5323                     if ($make_index && ! -f $index) {
5324                         open(INDX,">$index");
5325                         close(INDX);
5326                     }
5327                     last;
5328                 }
5329             }
5330             &error("登録できませんでした。","パスワードを変更してもう一度登録してください。$path") if ! $mkd_suc;
5331             my $time = time;
5332             my $limit_size = 1024 * 1024 * $max_mb;
5333             my $new_id = &change(param('new_id'));
5334             my $new_line = join(',', $time, $new_id, $path, $enc_pass, 3, $limit_size, param('new_mail'),$auto_delete,$max_dl_count);
5335             $new_line .= ",\n";
5336             push(@user,$new_line);
5337             open(USR,">./user.cgi");
5338             print USR @user;
5339             close(USR);
5340             
5341             my $pass_file_path = join('/', $passdir, 'upload/usr_root', substr($enc_pass,0,13), '.htpasswd');    # パスワードファイルのパス
5342             if ($use_htaccess) {
5343                 my $pass_file_dir = $pass_file_path;
5344                 $pass_file_dir =~ s/\/\.htpasswd//;
5345                 &make_dir($pass_file_dir) if ! -d $pass_file_dir;    # パスワードファイルを置くディレクトリが存在しなければ作成
5346                 my $pass_file = qq($fullpath/$pass_file_path);
5347                 my $hta_str = <<"EOF";
5348 AuthType Basic
5349 AuthName "マルチアップロード認証"
5350 AuthUserFile $pass_file
5351 require valid-user
5352 <Files ~ "^.(htpasswd|htaccess)$">
5353  deny from all
5354 </Files>
5355 EOF
5356                 my $htac = join('/', $path, $htaccess);
5357                 open(HTA,">$htac");
5358                 print HTA $hta_str;
5359                 close(HTA);
5360                 ##.htpasswd作成
5361                 open(PSS,">$pass_file_path");
5362                 print PSS param('new_id') . qq(:$enc_pass\n);
5363                 print PSS qq($admin_id:$adminpass);
5364                 close(PSS);
5365             }
5366             my $e_new_raw_pass = &change(param('new_pass'));
5367             my $new_raw_pass = join(',',$time,$e_new_raw_pass) . ',';
5368             my $raw_pass_path = join('/',$passdir,'raw_pass.cgi');
5369             open(RAW,">>$raw_pass_path");
5370             print RAW $new_raw_pass . "\n";
5371             close(RAW);
5372             &unlock();
5373 
5374             $html .= qq(<div style="text-align:center;margin:1em">) . param('new_id') . qq(${mr}を登録しました。</div>\n);
5375             my $cid = param('new_id');
5376             my $cpass = param('new_pass');
5377             my $mail = param('new_mail');
5378             my $send_mail;
5379             if ($mail) {
5380                 $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">登録内容を$mailに送信する</label></td></tr>);
5381             }
5382             $html .= <<"EOF";
5383 <div style="text-align:center;">
5384 <form action="$script" method="post">
5385 <input type="hidden" name="mode" value="$mode" />
5386 <table style="margin:auto" summary="ログインフォーム">
5387 <tr><td colspan="2"style="text-align:center;"><input type="submit" value="ログイン" tabindex="1" /></td></tr>
5388 <tr><td align="right">ユーザー名</td><td align="left"><input type="text" name="id" value="$cid" style="width:120px;height:16px" tabindex="2" /></td></tr>
5389 <tr><td align="right">パスワード</td><td align="left"><input type="password" name="pass" value="$cpass" style="width:120px;height:16px" tabindex="3" /></td></tr>
5390 <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">登録内容をクッキーに保存する</label></td></tr>
5391 $send_mail
5392 </table>
5393 </form>
5394 </div>
5395 EOF
5396             if ($mail_notify && @admin_mail) {
5397                 my ($mail_title, @msg, $msg);
5398                 $mail_title = '【' . $simple_title . '】' . param('new_id') . "${mr}登録";
5399                 my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
5400                 $year+=1900;
5401                 $mon++;
5402                 my $tm_com =sprintf("%02d/%02d/%02d %02d:%02d",$year,$mon,$day,$hour,$min);
5403                 @msg = &read_file('./mail_template/u2a_new.txt');
5404                 $msg = join('',@msg);
5405                 my $url = url;
5406                 my $new_user = param('new_id');
5407                 my $dir = $url . qq(?dir=) . join('/', $updir, 'usr_root', $enc_pass,);
5408                 $msg =~ s/<date>/$tm_com/g;
5409                 $msg =~ s/<title>/$simple_title/g;
5410                 $msg =~ s/<user>/$new_user/g;
5411                 $msg =~ s/<mr>/$mr/g;
5412                 $msg =~ s/<url>/$url/g;
5413                 $msg =~ s/<dir>/$dir/g;
5414                 foreach (@admin_mail) {
5415                     &notify($mail_title, $msg, $_);
5416                 }
5417             }
5418         } else {
5419             my $mail_nec;
5420             $mail_nec = '<span style="color:red;font-size:80%">※必須</span>' if $user_mail_neces;
5421             my ($auto_pass,$auto_pass_com,$hidden) = &auto_pass_frm;
5422             my $new_id = param('new_id');
5423             my $new_pass = param('new_pass');
5424             $new_pass = $auto_pass if $auto_pass;
5425             my $new_mail = param('new_mail');
5426             my $chr;
5427             $html .= <<"EOF";
5428 <div style="text-align:center;margin:1em">
5429 登録するユーザー名、パスワードを入力して「登録」ボタンを押してください
5430 <form action="$script" method="post">
5431 <input type="hidden" name="mode" value="$mode" />
5432 <input type="hidden" name="usr_regist" value="1" />
5433 $hidden
5434 <table border="1" cellpadding="4" cellspacing="0" style="margin:auto" summary="新規登録フォーム">
5435 <tr><td colspan="2" style="text-align:center;"><input type="submit" value="登 録" tabindex="1" />&nbsp;&nbsp;<input type="submit" name="cancel" value="キャンセル" tabindex="2" /></td></tr>
5436 <tr><td align="right">ユーザー名<span style="color:red;font-size:80%">※必須$chr</span></td><td align="left"><input type="text" name="new_id" value="$new_id" style="width:120px;height:16px" tabindex="3" /></td></tr>
5437 <tr><td align="right">パスワード<span style="color:red;font-size:80%">※必須</span></td><td align="left"><input type="text" name="new_pass" value="$new_pass" style="width:120px;height:16px" tabindex="4" /></td></tr>
5438 $auto_pass_com
5439 <tr><td colspan="2" style="text-align:right;"><span style="font-size:80%">※パスワードに</span>&nbsp;<span style="font-weight:bold;font-size:120%">$ban</span>&nbsp;<span style="font-size:80%">は使用しないでください</span>
5440 </td></tr>
5441 <tr><td align="right">メールアドレス$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>
5442 </table>
5443 </form>
5444 </div>
5445 EOF
5446         }
5447     # ログインフォームを表示
5448     } else {
5449         my ($cid,$cpass,$cuse_cook) = &get_cookie;
5450         if (!$cid && $id) { $cid = $id; }
5451         if (!$cpass && $pass) { $cpass = $pass; }
5452         my ($hidden, $pass_name);
5453         if (param('dir')) { $hidden .= qq(<input type="hidden" name="dir" value=") . param('dir') . qq(" />); }
5454         if (param('time')) {
5455             $hidden .= qq(<input type="hidden" name="time" value=") . param('time') . qq(" />);
5456             $pass_name = 'tpass';
5457             $cpass = param('tpass');
5458             $cid = param('id') if param('id');
5459         } else {
5460             $pass_name = 'pass';
5461         }
5462         if (param('file')) { $hidden .= qq(<input type="hidden" name="file" value=") . param('file') . qq(" />); }
5463         my $message;
5464         if (param('message')) { $message = '<div style="color:red">' . param('message') . '</div>'; }
5465         if ($comment) { $message .= '<div style="color:red">' . $comment . '</div>'; }
5466         my $chk = '';
5467         if ($cuse_cook) { $chk = qq( checked="checked"); }
5468         my $return;
5469         if ($show_return) {
5470             if ($return_url) {
5471                 if ($return_name) {
5472                     $return = qq(<a href="$return_url">${return_name}に戻る</a>&nbsp;);
5473                 } else {
5474                     $return = qq(<a href="$return_url">前のページに戻る</a>&nbsp;);
5475                 }
5476             } else {
5477                 $return = qq(<a href="javascript:history.back()">前のページに戻る</a>&nbsp;);
5478             }
5479         }
5480         $cid = param('dptid') if param('dptid');
5481         $html .= <<"EOF";
5482 <div style="text-align:center;">
5483 <form action="$script" method="post">
5484 <input type="hidden" name="mode" value="$mode" />
5485 $hidden
5486 $message
5487 <table style="margin:auto" summary="ログインフォーム">
5488 <tr><td colspan="2" style="text-align:center;">$return<input type="submit" value="ログイン" tabindex="1" /></td></tr>
5489 <tr><td style="text-align:right;">ユーザー名</td><td align="left"><input type="text" name="id" value="$cid" style="width:120px;height:16px" tabindex="2" /></td></tr>
5490 <tr><td style="text-align:right;">パスワード</td><td align="left"><input type="password" name="$pass_name" value="$cpass" style="width:120px;height:16px" tabindex="3" /></td></tr>
5491 <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">クッキーを使用する</label></td></tr>
5492 </table>
5493 </form>
5494 </div>
5495 EOF
5496         if ($user_regist) {
5497             $html .= qq(<div style="margin-top:2em;text-align:center;">\n);
5498             $html .= qq(<form action="$script" method="post"><input type="hidden" name="usr_regist" value="1" /><input type="submit" value="新規登録する" tabindex="5" /></form>\n);
5499             $html .= qq(</div>\n);
5500         }
5501     }
5502     if (param('new_id') && param('new_pass')) {
5503         &set_cookie(param('new_id'), param('new_pass'),param('save_cook'));
5504     }
5505     &header;
5506     print $html;
5507     &footer;
5508 }
5509 
5510 
5511 sub change {
5512     my $str = $_[0];
5513     $str =~ s/\,/&comma;/g;
5514     $str;
5515 }
5516 
5517 
5518 sub rechange {
5519     my $str = $_[0];
5520     $str =~ s/&comma;/,/g;
5521     $str;
5522 }
5523 
5524 
5525 #-------------------------------------------------
5526 # パスワード暗号処理
5527 #-------------------------------------------------
5528 sub encrypt_old {
5529     my($inpw) = $_[0];
5530     my(@SALT, $salt, $encrypt);
5531     if ($inpw =~ /([$ban])/) {
5532         &error("パスワードエラー","「$1」はパスワードに含めないでください。");
5533     }
5534     @SALT = ('a'..'z', 'A'..'Z', '0'..'9');
5535     srand(int(rand(100000)));
5536     $salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5537     $encrypt = crypt($inpw, $salt) || crypt ($inpw, '$1$' . $salt);
5538     $encrypt;
5539 }
5540 
5541 sub encrypt {
5542     my($inpw) = $_[0];
5543     if ($inpw =~ /([$ban])/) {
5544         &error("パスワードエラー","「$1」はパスワードに含めないでください。");
5545     }
5546     my $encrypt;
5547     if ($code == 2) {
5548         use Digest::MD5 qw/md5_hex/;
5549         my @str = ('a' .. 'f', 0 .. 9);
5550         my $salt;
5551         for (1 .. 8) {
5552             $salt .= $str[int(rand(@str))];
5553         }
5554         $encrypt = $salt . md5_hex($salt . $inpw);
5555     } else {
5556         my(@SALT, $salt);
5557         @SALT = ('a'..'z', 'A'..'Z', '0'..'9');
5558         srand(int(rand(100000)));
5559         $salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5560         $encrypt = crypt($inpw, $salt) || crypt ($inpw, '$1$' . $salt);
5561         if (length($inpw) > 8) {
5562             my $inpw2 = substr($inpw,8,8);
5563             srand(int(rand(100000)));
5564             my $salt2 = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
5565             my $encrypt2 = crypt($inpw2, $salt2) || crypt ($inpw2, '$1$' . $salt2);
5566             $encrypt .= $encrypt2;
5567         }
5568     }
5569     $encrypt;
5570 }
5571 
5572 
5573 #-------------------------------------------------
5574 # パスワード照合処理
5575 #-------------------------------------------------
5576 sub decrypt_old {
5577     my($inpw, $logpw) = @_;
5578     my($salt, $check);
5579     $salt = $logpw =~ /^\$1\$(.*)\$/ && $1 || substr($logpw, 0, 2);
5580     $check = "no";
5581     if (crypt($inpw, $salt) eq $logpw || crypt($inpw, '$1$' . $salt) eq $logpw)
5582         { $check = "yes"; }
5583     $check;
5584 }
5585 
5586 sub decrypt {
5587     my($inpw, $logpw) = @_;
5588     my($salt, $check);
5589     if (length($logpw) == 40) {
5590         # saltは先頭の8文字を抜き出す
5591         my $salt = substr($logpw, 0, 8);
5592         $check = "no";
5593         # 照合
5594         if ($logpw eq ($salt . md5_hex($salt . $inpw))) {
5595             $check = "yes";
5596         }
5597     } else {
5598         my $logpw1 = substr($logpw,0,13);
5599         my $inpw1 = substr($logpw,0,8);
5600         $salt = $logpw1 =~ /^\$1\$(.*)\$/ && $1 || substr($logpw1, 0, 2);
5601         $check = "no";
5602         if (crypt($inpw, $salt) eq $logpw1 || crypt($inpw1, '$1$' . $salt) eq $logpw1) {
5603             $check = "yes";
5604         }
5605         if ($check eq "yes" && length($logpw) == 26) {
5606             my $logpw2 = substr($logpw,13,13);
5607             my $inpw2 = substr($inpw,8,8);
5608             my $salt2 = $logpw2 =~ /^\$1\$(.*)\$/ && $1 || substr($logpw2, 0, 2);
5609             if (crypt($inpw2, $salt2) eq $logpw2 || crypt($inpw2, '$1$' . $salt2) eq $logpw2) {
5610                 $check = "yes";
5611             } else {
5612                 $check = "no";
5613             }
5614         }
5615     }
5616     $check;
5617 }
5618 
5619 
5620 sub auto_pass {
5621     my ($length,$al,$dg,$mk) = @_;
5622     my $auto_pass;
5623     $length = 8 if ! $length;
5624     $al = 1 if ! $al && ! $dg && ! $mk;
5625     my @salt = ();
5626     if ($al) {
5627         push(@salt,('a'..'z', 'A'..'Z'));
5628     }
5629     if ($dg) {
5630         push(@salt,('0'..'9'));
5631     }
5632     if ($mk) {
5633         push(@salt,('\\','!','$','%','\'','\(','\)','=','-','^','~','`',':','*','?','/','_','<','>','\,','.','|','[',']','{', '}','「','」','・','@'));
5634     }
5635     srand;
5636     for (1 .. $length) {
5637         $auto_pass .= $salt[int(rand(@salt))];
5638     }
5639     return $auto_pass;
5640 }
5641 
5642 
5643 sub auto_pass_frm {
5644     my ($auto_pass, $auto_path_str, $auto_pass_frm,$al,$dg,$mk,$al_chk,$dg_chk,$mk_chk,$hidden);
5645     my $tindx = $_[0];
5646     $auto_path_str = "パスワードを自動生成する";
5647     if (param('auto_pass')) {
5648         $auto_path_str = "パスワード生成";
5649         $al = param('al');
5650         $dg = param('dg');
5651         $mk = param('mk');
5652         if (! param('auto_pass_re')) {
5653             $al = 1;
5654             $dg = 1;
5655             $mk = 1;
5656         }
5657         if (! $al && ! $dg && ! $mk) {
5658             $al = 1;
5659         }
5660         my $length_com = qq(<select name="length">\n);
5661         my $length = param('length');
5662         $length = 10 if ! $length;
5663         for (my $i=$pass_length; $i <= ($auto_pass_length + 10); $i++) {
5664             my $sel;
5665             if ($length == $i) {
5666                 $sel = qq( selected="selected");
5667             }
5668             $length_com .= qq(<option value="$i"$sel>$i</option>);
5669         }
5670         $length_com .= qq(</select>文字);
5671         $auto_pass = &auto_pass($length, $al, $dg, $mk);
5672         $al_chk = qq( checked="checked") if $al;
5673         $dg_chk = qq( checked="checked") if $dg;
5674         $mk_chk = qq( checked="checked") if $mk;
5675         $hidden = qq(<input type="hidden" name="auto_pass_re" value="1" />\n);
5676         if ($auto_pass) {
5677             $hidden .= qq(<input type="hidden" name="pass_gene" value="$auto_pass" />\n);
5678             $auto_path_str = "パスワード再生成";
5679             my $e_auto_pass = $auto_pass;
5680             $e_auto_pass =~ s/</&lt;/g;
5681             $e_auto_pass =~ s/>/&gt;/g;
5682         }
5683         $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++;
5684         $auto_pass_frm .= qq(<td><input type="checkbox" name="al"$al_chk id="al" value="1" tabindex="$tindx" /><label for="al">英</label>&nbsp;);    $tindx++;
5685         $auto_pass_frm .= qq(<input type="checkbox" name="dg"$dg_chk id="dg" value="1" tabindex="$tindx" /><label for="dg">数</label>&nbsp;);    $tindx++;
5686         $auto_pass_frm .= qq(<input type="checkbox" name="mk"$mk_chk id="mk" value="1" tabindex="$tindx" /><label for="mk">記</label>&nbsp;$length_com</td></tr>\n);    $tindx++;
5687         $auto_pass_frm .= qq(</td></tr>\n);
5688     } else {
5689         $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++;
5690     }
5691     return($auto_pass,$auto_pass_frm,$hidden,$tindx);
5692 }
5693 
5694 
5695 sub error {
5696     $error_header = 1;
5697     if ($lockflag) {
5698         &unlock($lockfile);
5699     }
5700     &header;
5701     print qq(<div style="margin:1em">\n);
5702     print "<h1>$_[0]</h1>\n";
5703     print "<div style=\"font-size:120%\">$_[1]</div><p>\n";
5704     print "ブラウザの[戻る]ボタンを押して前の画面に移動してください.</p>\n";
5705     print qq(</div>\n);
5706     &footer;
5707     exit;
5708 }
5709 
5710 
5711 
5712 
5713 #サイズ測定
5714 sub size_measure {
5715     my($path) = shift;
5716     my($size) = 0;
5717     my(@dir);
5718     opendir(DIR, $path) or return;
5719     while(my $entry = readdir(DIR)){
5720         next if $entry eq '.' || $entry eq '..';
5721         if(-d "$path/$entry"){
5722             push(@dir, $entry);
5723             $dir_nmb++;
5724         } else {
5725             $size +=(-s "$path/$entry");
5726             $file_nmb++;
5727         }
5728     }
5729     closedir(DIR);
5730     foreach my $temp(@dir){
5731         $size += &size_measure("$path/$temp");
5732     }
5733     return $size;
5734 }
5735 
5736 sub kiro_byte {
5737     my $byte = $_[0];
5738     if ($byte ne '') {
5739         if ($byte / 10 >= 1024 *1024) {
5740             return int($byte / (1024 *1024)) . 'MB';
5741         } elsif ($byte >= 1024) {
5742             return &comma(int($byte / 1024)) . 'KB';
5743         } else {
5744             if ($byte) {
5745                 return $byte . 'byte';
5746             } else {
5747                 return $byte;
5748             }
5749         }
5750     }
5751 }
5752 
5753 
5754 
5755 sub save_accesslog {
5756     my($tm) = shift;
5757     my($check);
5758     my($retrytime) = 5;
5759     my($retrynum) = 10;
5760 
5761     my($time) = &presenttime;
5762     my($host) = $ENV{'REMOTE_HOST'};
5763     my($addr) = $ENV{'REMOTE_ADDR'};
5764     if ($host eq "" || $host eq "$addr") {
5765         $host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
5766         if ($host eq "") { $host = $addr; }
5767     }
5768     my $tmp_id = &change($id);
5769     $tmp_id .= qq|(管理者)| if $administrator;
5770     $tmp_id .= qq|(ゲスト)| if $tpass || $login_guest;
5771     my($str) = "$tmp_id,$time,$host,$tm,\n";
5772     my @access = ();
5773 
5774     if (!-e $access) {
5775         open(NEW,">$access");
5776         close(NEW);
5777     }
5778     if ($lock) { &lock('acc.lock'); }
5779     if (open ACCE, "$access") {
5780         @access = <ACCE>;
5781         close(ACCE);
5782     }
5783     unshift(@access, $str);
5784     if($save_num){
5785         @access = splice(@access, 0, $save_num);
5786     }
5787     if (open(ACC,">$access")) {
5788         print ACC @access;
5789         close(ACC);
5790     }
5791     if (! -d $access_dir) {
5792         mkdir $access_dir;
5793     }
5794     my $log_path = join('/',$access_dir,$tm);
5795     if ($administrator) {
5796         $log_path .= 'a';
5797     } elsif ($tpass || $login_guest) {
5798         $log_path .= 't';
5799     }
5800     $log_path .= '.cgi';
5801     if (open(LOG,"$log_path")) {
5802         # ログの行数を$save_num行に切り詰める いまいちすっきりしない
5803         my @acclog = <LOG>;
5804         close(LOG);
5805         my $ofs = $save_num -1;
5806         $ofs = scalar(@acclog) if $ofs > scalar(@acclog);
5807         $ofs *= -1;
5808         @acclog = splice(@acclog, $ofs, $save_num);
5809         open(LOG,">$log_path");
5810         print LOG @acclog;
5811         close(LOG);
5812     }
5813     open(LOG, ">>$log_path");
5814     print LOG $str;
5815     close(LOG);
5816     if ($lock) { &unlock('acc.lock'); }
5817 }
5818 
5819 
5820 sub presenttime {
5821     my $tm = $_[0];
5822     $tm = time if ! $tm;
5823     my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isset) = localtime($tm);
5824     my @youbi = ("日", "月", "火", "水", "木", "金", "土");
5825     $wday = $youbi[$wday];
5826     $year += 1900;
5827     $month++;
5828     my($time) = sprintf("%04d/%01d/%01d(%s) %02d:%02d:%02d",$year,$month,$mday,$wday,$hour,$min,$sec);
5829     return ($time);
5830 }
5831 
5832 
5833 sub set_cookie {
5834     my(@cook) = @_;
5835     my($gmt, $cook, @t, @m, @w);
5836 
5837     @t = gmtime(time + 60*24*60*$c_val_term);
5838     @m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
5839     @w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
5840 
5841     # 国際標準時を定義
5842     $gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
5843             $w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
5844 
5845     #
5846     my $save_cokkie = $cook[2];
5847     if (!$save_cokkie) {
5848         @cook = ();
5849     }
5850     
5851     # 保存データをURLエンコード
5852     foreach (@cook) {
5853         s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
5854         $cook .= "$_<>";
5855     }
5856 
5857     # 格納
5858     print "Set-Cookie: $cookname=$cook; expires=$gmt\n";
5859 }
5860 
5861 #-------------------------------------------------
5862 # クッキー取得
5863 #-------------------------------------------------
5864 sub get_cookie {
5865     my($key, $val, %cook, $cook, @cook);
5866 
5867     # クッキーを取得
5868     $cook = $ENV{'HTTP_COOKIE'};
5869 
5870     # 該当IDを取り出す
5871     foreach ( split(/;/, $cook) ) {
5872         ($key, $val) = split(/=/);
5873         $key =~ s/\s//g;
5874         $cook{$key} = $val;
5875     }
5876 
5877     # データをURLデコードして復元
5878     foreach ( split(/<>/, $cook{"$cookname"}) ) {
5879         s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
5880         push(@cook,$_);
5881     }
5882     return (@cook);
5883 }
5884 
5885 sub comma {
5886  my $text = reverse $_[0];
5887  $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
5888  return scalar reverse $text;
5889 }
5890 
5891 sub get_unique {
5892     my(%count,@list);
5893     @list = @_;
5894     my @unique_list = grep(!$count{$_}++, @list);
5895     return @unique_list;
5896 }
5897 
5898 
5899 
5900 sub lock {
5901     mkdir $lockdir if ! -d $lockdir;
5902     my $lck = $_[0];
5903     if ($lck) {
5904         $lockfile = $lck;
5905     } else {
5906         $lck = $lockfile;
5907     }
5908     my $lockpath = "$lockdir/$lck";
5909 
5910     # 1分以上古いロックは削除する
5911     if (-e $lockpath) {
5912         my($mtime) = (stat($lockpath))[9];
5913         if ($mtime < time - 60) { &unlock; }
5914     }
5915     my $retry = 5;
5916     my $e_mes = "<br />もうしばらく待ってもう一度実行してください。";
5917     # symlink関数式ロック
5918     if ($lockkey == 1) {
5919         while (!symlink(".", $lockpath)) {
5920             if (--$retry <= 0) { &error('エラー','Lock is busy'); }
5921             sleep(1);
5922         }
5923     # mkdir関数式ロック
5924     } elsif ($lockkey == 2) {
5925         while (!mkdir($lockpath, 0755)) {
5926             if (--$retry <= 0) { &error("Lock is busy","$e_mes"); }
5927             sleep(1);
5928         }
5929     }
5930     $lockflag = 1;
5931 }
5932 
5933 
5934 sub unlock {
5935     my $lck = $_[0];
5936     if ($lck) {
5937         $lockfile = $lck;
5938     } else {
5939         $lck = $lockfile;
5940     }
5941     my $lockpath = "$lockdir/$lck";
5942     if ($lockkey == 1) { unlink($lockpath); }
5943     elsif ($lockkey == 2) { rmdir($lockpath); }
5944     $lockflag=0;
5945 }
5946 
5947 
5948 sub url_param {
5949     my %param = @_;
5950     my $count = 0;
5951     my $url;
5952     foreach (sort keys %param) {
5953         if ($param{"$_"}) {
5954             if (! $count) {
5955                 $url .= "?" . $_ . qq(=$param{"$_"});
5956                 $count++;
5957             } else {
5958                 $url .= "&amp;" . $_ . qq(=$param{"$_"});
5959             }
5960         }
5961     }
5962     return $url;
5963 }
5964 
5965 
5966 sub hidden_param {
5967     my %param = @_;
5968     my $hidden;
5969     foreach (sort keys %param) {
5970         if ($param{"$_"}) {
5971             my $decode = &url_decode($param{"$_"});
5972             $hidden .= qq(<input type="hidden" name="$_" value="$decode" />\n);
5973         }
5974     }
5975     return $hidden;
5976 }
5977 
5978 # delete.logの管理
5979 sub delete_log {
5980     my @del_list = @_;
5981     &lock('delete.lock');
5982     if (open(DEL,">>./delete.log")) {
5983         foreach (@del_list) {
5984             print DEL time . qq(<>$_\n);
5985         }
5986         close(DEL);
5987     }
5988     # 容量100KB超えたら
5989     if ((stat('./delete.log'))[7] > 1024 * 100) {
5990         opendir(DIR,'.');
5991         my $max_ex = 0;
5992         while (my $file = readdir(DIR)) {
5993             if ($file =~ /\.(\d{3}$)/) {
5994                 if ($1 > $max_ex) {
5995                     $max_ex = $1;
5996                 }
5997             }
5998         }
5999         closedir(DIR);
6000         $max_ex++;
6001         my $ext = sprintf("%03d",$max_ex);
6002         rename './delete.log','./delete.' . $ext;
6003     }
6004     &unlock('delete.lock');
6005 }
6006 
6007 
6008 sub get_millisec {
6009     return (times)[0];
6010 }
6011 
6012 sub get_microsec {
6013     use Time::HiRes qw(gettimeofday);
6014     my ($sec, $microsec) = gettimeofday;
6015     return ($sec, $microsec);
6016 }
6017 
6018 
6019 sub time_format {
6020     my ($sec,$msec) = @_;
6021     my ($hour,$min,$com);
6022     if ($sec > 3600) {
6023         $hour = int($sec / 3600);
6024         $sec -= $hour * 3600;
6025     }
6026     if ($sec > 60) {
6027         $min = int($sec / 60);
6028         $sec -= $min * 60;
6029     }
6030     $com .= qq(${hour}時間) if $hour;
6031     $com .= qq(${min}分) if $min;
6032     $msec = sprintf("%.2f",$msec/1000000);
6033     $com .= ($sec + $msec) . '秒';
6034 }
6035 
6036 
6037 sub key_color {
6038     my ($str,$key) = @_;
6039     return $str if ! $key;
6040     my $ascii = '[\x00-\x7F]';
6041     my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
6042     my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
6043     if ($encode_lib == 1) {
6044         eval 'use Jcode;';
6045         Jcode::convert(\$str, "euc");
6046         Jcode::convert(\$key, "euc");
6047     } else {
6048         require 'jcode.pl';
6049         &jcode::convert(\$str, "euc");
6050         &jcode::convert(\$key, "euc");
6051     }
6052     my $replace = qq(<span style="background-color:#ffffcc;color:#ff0000">$key</span>);
6053     $str =~ s/\G((?:$ascii|$twoBytes|$threeBytes)*?)(?:$key)/$1$replace/g;
6054     if ($encode_lib == 1) {
6055         Jcode::convert(\$str, "sjis");
6056     } else {
6057         &jcode::convert(\$str, "sjis");
6058     }
6059     return $str;
6060 }
6061 
6062 
6063 sub random_str{
6064     my $length = $_[0];
6065     $length = 10 if ! $length;
6066     my @salt = ('a'..'z', 'A'..'Z', '0'..'9');
6067     srand;
6068     my $login_id;
6069     for (1 .. $length) {
6070         $login_id .= $salt[int(rand(@salt))];
6071     }
6072     return $login_id
6073 }
6074 
6075 
6076 
perlからPHPへの書き換え補助 perl2php.php ver.1.2