Perl でファイルアップロードさせる方法

Perl の CGI でフォームからアップロードされたファイルを受取り、サーバマシン上に保存する方法を解説します。

ファイルアップロードができるCGIプログラムを探しているという方はこちらをどうぞ
「すぐ使えるCMS」

使用する Perl モジュール

CGI
File::Basename

処理のポイント

むやみやたらとファイルを受け付けると、大量/大容量ファイルの処理でサーバ機能が停止してしまう可能性があるので、受付できるファイルの容量制限をします。
危険なファイル、意図しないファイルをアップロードされないよう、ファイルの種類の制限を行います。
同じ名前のファイルを送信された場合でも旧いファイルを上書きすることの無いように、ファイルごとに一意な（サーバマシン上の）ファイルパスを設定します。

ファイルアップロード用送信元フォーム

以下が、ファイルアップロード用の送信元フォームのHTMLファイル全体です。

普通のフォームですが、フォームのエンコーディングタイプとして、「ENCTYPE="multipart/form-data"」を指定しています。ファイルを転送する場合はこれにしなければなりません。

アップロードするファイルをクライアントのローカルマシンから選んでもらうための INPUT 要素は、TYPE=”file” です。

<!DOCTYPE HTML PUBLIC "-//W3C//DTD
HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<title>ファイルアップロード</title>
</head>

ファイル選択： <input type="file" name="upload_file"
size="60">
<input type="submit" value="アップロード">
</form>
</body>
</html>

ちょっと雑学

フォームに ENCTYPE 指定していない場合、デフォルトは ENCTYPE="application/x-www-form-urlencoded"
なのですが、MIME タイプのお約束として、この「x-」は、（誰かが）自由に作った MIME タイプである、という意味合いがあるそうです。「application/x-mytype」なんてことを宣言できる、ということらしいです。そんなのでも、標準になっちゃったりするんですね。

ファイルアップロード用 Perl CGI (I) 初期設定等

一連のプログラムコードを順番に解説していきます。

まず perl のパスの設定とモジュールのロード、変数宣言を行います。

#!/usr/bin/perl -w

#使用するモジュールをロード
use File::Basename;
use CGI;

#変数宣言
my ($form, $dir, $filename, $parsename, @filename,
$error, $ok, $type, $newfile, $i,
$buffer, @ext_ok);

環境設定をします。
$dir は、この下に、「upload_(一意な文字列)」と言う名前のディレクトリを作成し、その中にアップロードされたファイルを送信元のファイルと同じファイル名で保存します。

#ファイルを保存するディレクトリを設定
#（CGIの実行ユーザで書き込み権限が必要）
$dir = ‘./files’;

@ext_ok は、受付可能なファイルの拡張子を設定します。
送信できるファイルの制限は、許可するものを指定する方法と拒否するものを指定する方法とが考えられますが、このサンプルでは、「許可するものを指定する」方法を採用しています。一般的に、その方が安全です。

送信されたファイルの拡張子が指定した中に含まれていれば、送信が許可されます（実際は、保存が許可される。ファイル名を取得する時には既に、web サーバがファイルのデータを受取切って、そのデータを内部的に保持している。CGIスクリプトがそれを保存しない場合、そのデータは破棄される。）。

#受付可能な拡張子（正規表現）
@ext_ok = qw (
txt
zip
pdf
doc
);

送信可能なサイズの上限を設定し、CGIオブジェクトを作成します。このあたりはモジュール CGI の機能です。詳細は、search.cpan.org
からモジュールのドキュメントを参照して下さい。

このように制限した場合でも、ファイルサイズの判断は、送信されてきたデータを全て受取り切った後です。送信そのものを打ち切りたい場合は、（WebサーバがApacheなら）Apacheの
LimitRequestBody ディレクティブで制限できます。
[>> Apache
のドキュメント（LimitRequestBody ディレクティブ）]

#転送できるファイルの最大サイズを設定
#（実際は、post送信されるコンテンツ合計の最大サイズ）
#この値は、CGIオブジェクトを作成する時には既に
#設定されていなければならない
$CGI::POST_MAX = 1024 * 1000; #max = 1MB

#CGIオブジェクトを作成
$form = new CGI;

ヘッダを出力します。

#クライアントにヘッダを送信
#これは、結果メッセージ表示のため

binmode STDOUT;
print "Content-Type: text/plain;charset=euc-jp\r\n\r\n";

ファイルアップロード用 Perl CGI (II) アップロード状況のチェック

次に、ファイルが送信されているかチェックします。

この条件は、2007年4月の更新で変更しました。以前のバージョンでは、「unless(defined($filename))」と、$filename
が未定義かどうかだけをチェックしていましたが、これだと Mac OS X の Netscape 7.1 の場合エラーの誤認が出るためです。
ブラウザがどのように値を送ってくるか、というのは個々のブラウザの仕様に依るので、実装時には対象とするブラウザでのテストを行うようにして下さい。

#ファイルの転送のチェック

if (!defined($filename) and $error = $form->cgi_error){

#ファイルが転送されていなかったら、$filename は未定義値となっている。
#フォーム上でファイルを選択しないままフォームがサブミットされた場合は、
#通常はこの変数 $filename は空文字列として定義されている（＝未定義ではない）。
#このため、以前のバージョンでは $filename が定義されている
#かどうかをエラーの判別の基準としていたが、
#2007年3月 Mac OS X 上の Netscape 7.1 で試したところ、
#ファイル選択されていない場合に未定義値になることが判明。
#このため、エラーの場合に設定される（筈の）値 $form->cgi_error も判別の
#基準に追加した。

print "ファイルが転送できませんでした：$error\n";
exit;
}

Perl 5.005 以下の場合

Perl 5.005 以下では、$CGI::POST_MAX を超えるファイルが送信された場合、

$form = new CGI;

の時点で CGI.pm が exit することにより処理が終了し、全体ではInternal Server Error となってしまいます。
このための代替コードは以下の通りです。

#Perl 5.005 以下用代替コードここから————————–

#CGIオブジェクトを作成
$form = eval{new CGI}; #eval で囲ってエラーをトラップ

#エラーがあれば、$form が定義されていないので、これを判別してeval が補足した
#エラーメッセージ $@ を $error にセット
$form or $error = $@ || ‘送信時にエラーがありました’; #エラーの場合の措置

#クライアントにヘッダを送信
binmode STDOUT;
print "Content-Type: text/plain;charset=euc-jp\r\n\r\n";

#アップロードされたファイルの情報を変数に格納
#この変数は、コンテクストによって色々な値を返してくれる
$filename = $parsename = $form->param(‘upload_file’) if $form; #$form の定義でエラーを判別

#ファイルの転送のチェック
if (!defined($filename) and $error){
print "ファイルが転送できませんでした：$error\n";
exit;
}

#Perl 5.005 以下用代替コードここまで————————–

ファイルアップロード用 Perl CGI (III) アップロードされたファイル名のチェック

ファイルが送信されている場合は、送信拒否すべきファイルでないかをチェックします。

「ベース名のチェック（アスキー文字列であること）」を行うと、ファイル名に日本語を含むファイルは送信できません。一般に、ファイル名に日本語等を使用すると何かと問題が出ることが多いのでこの例では制限を付けていますが、CGI（送信フォーム）とファイル名の使用文字コードが一致していれば日本語ファイルの送信自体は問題なく行えます。

例えば、フォームとCGIをShift_JISで作成→WindowsやMacからファイルをアップロード→アップロードされたファイルをWindowsにインストールされたFTPソフトで管理者のPCにダウンロードする、等の場合は全てShift_JISの環境なので、日本語ファイル名を受け付けても特に問題が出ません。
ただし、 Shift_JIS の場合は、保存時にファイル名の一部が欠けてしまう場合があります。この問題についてはいずれ別の記事で解説します。

フォームとCGIの文字コードと送信元のOSの文字コード（つまり、ファイル名の文字コード）が異なる場合、ブラウザによってはCGI側でコンテンツをうまく取得できないことがあります。うまくいかないことが明らかなブラウザは
Netscape 4.x（Windows）です。IE 4.x 以上（Windows）、IE5.5（Mac）、Opera6.x以上（Windows）等では、特に問題が出ないようです。

if ($filename) { #ファイルが転送されていれば、値は真

#ファイルパス内の「\」を「/」に変換
# $parsename には、送信元クライアントマシン内での
#ファイルパスが格納されている。
#注：Shift_JISで実装する場合、このあたりには工夫が必要。

$parsename =~ s#\\#/#g;

#ファイル名を（ベース名, ディレクトリ名, 拡張子）に分解
@filename = fileparse($parsename, "\.[^\.]+");

#ベース名のチェック（アスキー文字列であること）
$filename[0] =~ /^[\.\w~-]+$/ and $filename[2] =~ /^[\.\w-]+$/ and $ok = 1;

unless ($ok) {
$error = ‘ファイル名は、半角英数字にして下さい。’;
print "ファイル転送ができませんでした。: $error\n";
exit;
}

$ok = 0; #フラグのリセット

#拡張子のチェック
foreach (@ext_ok){
$filename[2] =~ /^\.$_$/ and $ok = 1 and last;
}

unless ($ok){
$error = "許可されていない拡張子($filename[2])です。";
print "ファイル転送ができませんでした。: $error\n";
exit;

ファイルアップロード用 Perl CGI (IV) ファイルの保存

サーバマシンに保存してよいファイルである場合、一意なファイルパスを設定します。（使用している関数 &gen_unique_key は、ファイルの最後に定義してあります。）

#サーバ側ファイル名の決定
#まず、セッションごとに一意のディレクトリ名を作成
while (-d "$dir") {
$dir = $dir.’/upload_’.&gen_unique_key(15);
}

#ファイルを格納するディレクトリを作成
unless (mkdir($dir, oct(777))){
print "保存ファイル用ディレクトリの作成に失敗しました。: $!\n";
exit;

#サーバ側のファイルパスを設定
$newfile = $dir."/".$filename[0].$filename[2];

#既に同名のファイルが存在した場合
#（複数の同名ファイルを同時にアップロードした場合など）は、
#ベース名にアンダースコアと番号を付けて別名にする
$i = 0;
while (-f "$newfile"){
$i++;
$newfile = $dir."/".$filename[0]."_".$i.$filename[2];
}

保存（書き出し）処理をします。

以前のバージョンには「改行コードの自動変換を停止～binmode.. 」が抜けていました。
これが無いと、バイナリファイルをアップロードした時にファイルが破壊される可能性があります。

#ファイルの保存
unless (open (OUTFILE,">$newfile")){
print "サーバ側の保存ファイルの作成に失敗しました。: $!\n";
exit;
}

#保存用ファイルを無事 open できた場合

#改行コードの自動変換を停止
binmode (OUTFILE);
binmode ($filename);

# $filename から内容を読み出して
#保存用ファイルに書き出す
#この場合、変数 $filename はファイルハンドルとして
#機能する
while (read($filename,$buffer,1024)) {
print OUTFILE $buffer;

#ファイルを close して終了メッセージを表示
#この場合、$filename は、送信元クライアント
#マシン内でのファイルパス（ブラウザが送信してきた値）を返す
close (OUTFILE)
and print "送信されたファイル ($filename) を右のファイル名で保存しました： $newfile\n"
or print "サーバ側の保存ファイルのクローズに失敗しました。: $!\n";

ファイルが送信されていない場合は、メッセージだけ表示して終了です。

} else {
# ファイルが転送されていない場合
# $filename は偽

print "ファイルはアップロードされていません。\n";
}

ファイルアップロード用 Perl CGI (VI) 関数

ランダムな文字列を作成する関数

#一意の文字列を作成するための関数
sub gen_unique_key($){
#生成する文字列の長さを引数で指定
my $length = shift;

my ($i, $tempval, $key, $chars, @chars);

   #引数で指定された文字列長さが、
   # 5以上 30以下の数値でない場合、15に設定
   #（範囲は、長からず短からず…。）
   ($length =~ m/^\d+$/ and $length >= 5 and $length <= 30
) or $length = 15;

   #使用する文字を指定（ディレクトリ名として使用できる文字を指定する）
   $chars = ‘abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890~-_’;
   @chars = split(//, $chars);

#乱数のタネを作る
srand(time|$$);

for ($i=0; $i<$length; $i++){

# @chars 配列の最大の添字までの乱数を生成する
$tempval = int(rand(scalar(@chars)));

      $key .= $chars[$tempval];
   }
   return $key;
}

参考書

「Perlデバッグ明快技法」（オーム社）

Martin Brown (著), 岡田長治 (翻訳)

ミヤビッチの穴

Perl プログラマの頭の中。Perl, CGI, JavaScript, etc…

Perl でファイルアップロードさせる方法

使用する Perl モジュール

処理のポイント

ファイルアップロード用送信元フォーム

ちょっと雑学

ファイルアップロード用 Perl CGI (I) 初期設定等

ファイルアップロード用 Perl CGI (II) アップロード状況のチェック

Perl 5.005 以下の場合

ファイルアップロード用 Perl CGI (III) アップロードされたファイル名のチェック

ファイルアップロード用 Perl CGI (IV) ファイルの保存

ファイルアップロード用 Perl CGI (VI) 関数

参考書

「Perlデバッグ明快技法」（オーム社）

使用する Perl モジュール

処理のポイント

ファイルアップロード用 送信元フォーム

ちょっと雑学

ファイルアップロード用 Perl CGI (I) 初期設定等

ファイルアップロード用 Perl CGI (II) アップロード状況のチェック

Perl 5.005 以下の場合

ファイルアップロード用 Perl CGI (III) アップロードされたファイル名のチェック

ファイルアップロード用 Perl CGI (IV) ファイルの保存

ファイルアップロード用 Perl CGI (VI) 関数

参考書

「Perlデバッグ明快技法」（オーム社）

ファイルアップロード用送信元フォーム