2014年10月31日 11:58
#!/usr/bin/perl -T
use warnings;
use strict;
#// ----------------------------------------------------------
#// Perl CGI ファイルアップロード
#// ----------------------------------------------------------
use CGI;
# 本番環境では削除する
use CGI::Carp qw(fatalsToBrowser);
# 最大ファイルサイズ 100 KB
$CGI::POST_MAX = 1024 * 100;
# プロトタイプ宣言
sub save_file($);
# CGI オブジェクト
my $q = new CGI;
# HTTP ヘッダ
print $q->header(-charset => 'euc-jp');
#// ----------------------------------------------------------
#// HTML
#// ----------------------------------------------------------
# HTML ヘッダ
print $q->start_html( -title => "アップローダー",
-lang => 'ja');
# フォーム スタート
print $q->h3('このフォームからファイルをアップロード出来ます'),
$q->start_form( -name => 'main_form');
# ファイルフィールド
print $q->p('アップロードするファイルを選択してください: '),
$q->filefield( -name => 'filename',
-size => 40,
-maxlength => 80);
# 投稿ボタン
print $q->hr;
print $q->submit(-value => 'アップロード');
print $q->hr;
# フォーム エンド
print $q->end_form;
# サイズ超過チェック
if (!$q->param('filename') && $q->cgi_error()) {
# 超過していた場合の処理
# HTTP ステータスコードを出力
print $q->p($q->cgi_error());
# エラーメッセージ
print <<'EOT';
<p>!! ファイルサイズが許容値を超えています。
<p>許容値に関してはシステム管理者に確認してください。
EOT
# アップロード可能なファイルサイズを出力
print $q->p("最大 : $CGI::POST_MAX byte (", $CGI::POST_MAX / 1024, "KB)");
print $q->hr, $q->end_html;
exit 0;
}
# ファイルアップロード
if ($q->param()) {
# 処理を担当するサブルーチン
save_file($q);
}
# HTML エンド
print $q->end_html;
# プログラム終了
exit 0;
#// ----------------------------------------------------------
#// ファイルアップロード処理
#// ----------------------------------------------------------
sub save_file($) {
# CGI オブジェクト取得
my ($q) = @_;
# For 関数 read()
my ($bytesread, $buffer);
# read() で 1 度に読込むデータサイズ
my $num_bytes = 1024;
# ファイルサイズを格納
my $totalbytes;
# ファイル名と同名のファイルハンドル
my $filename = $q->upload('filename');
# 汚染チェック後のファイル名を格納
my $untainted_filename;
# ファイル名が入力されていない場合
if (!$filename) {
print $q->p('ファイルを選択してください。');
return;
}
# ファイル名の汚染チェック
if ($filename =~ /^([-\@:\/\\\w.]+)$/) {
# 除染したファイル名の文字列を取得
$untainted_filename = $1;
} else {
# 汚染されていた場合は die
die <<"EOT";
ファイル名にサポートしていない文字が含まれています。
ファイル名に利用可能な文字は "アルファベット" と "数字"
および 次の記号です。
「 _ 」「 - 」「 \@ 」「 / 」「 \\ 」「 . 」
EOT
}
# 続・汚染チェック
if ($untainted_filename =~ /\.\./) {
# 汚染されていた場合は die
die <<"EOT";
ファイル名に連続したピリオド「 .. 」が含まれています。
「 .. 」を除外したファイル名で再度アップロードしてください。
EOT
}
# ファイルの書き込み先を設定
my $file = "UPFILE/$untainted_filename";
print $q->p("$filename を $file にアップロードします。");
# 書き込みモードのファイルハンドルをオープン
open (OUTFILE, ">", "$file") or die "Couldn't open $file for writing: $!";
# ループ : データの読み込みと書き込み
while ($bytesread = read($filename, $buffer, $num_bytes)) {
# ファイルサイズの累算
$totalbytes += $bytesread;
# 指定領域に書き込み
print OUTFILE $buffer;
}
# エラーチェック : $bytesread が undef なら die
die "データの読み込みが失敗しました。" unless defined($bytesread);
# 続・エラーチェック : $totalbytes が undef なら
unless (defined($totalbytes)) {
print $q->p("エラー: ファイルを読み込めませんでした ${untainted_filename}, ");
print $q->p("またはファイルの長さがゼロです。");
} else {
# エラーチェッククリア : 完了のメッセージ
print $q->p("完了。ファイル $filename を $file にアップロードしました ($totalbytes bytes)");
}
# ファイルハンドルクローズ
close OUTFILE or die "$file をクローズ出来ませんでした : $!";
# アップロード処理のサブルーチン終了
}