Query.pm は CGI への入力を整理し，保持する Perl モジュールです。
GET メソッドでの QUERY_STRING，application/x-www-form-urlencoded (要するに普通の POST) および multipart/form-data (ファイルアップロード時の POST) に対応しています。
use strict;
use Query;
# デフォルトではファイルのアップロードはできない。
my $value = Query::get('key', 'default value');
# Query::get() メソッドの第1引数は input 要素 name 属性に対応する。
# 第2引数は，obj が送信されなかった場合のデフォルト値を指定する。
binmode(STDOUT);
print "Content-type: text/html\r\n\r\n";
if (ref $value eq 'ARRAY') {
# 得られたものがリストのリファレンスなら，
# 同名の name 属性の入力がいくつかあった事を表す。
print '<ul>';
foreach (@$value) {
print "<li>$_</li>";
}
print '</ul>';
}
else {
# ただのスカラ
print "<p>$value</p>";
}
use strict;
use Query ({
directory => 'updir',
uploadable => 1024 * 1024,
});
# ディレクトリ updir にファイルをアップロードする設定。
# ハッシュのリファレンスを与える事で設定を行う。
# この設定では，1024KiBytes までファイルをアップロード可能。
# デフォルトでは，ファイル名は自動で付与される。
my $obj = Query::get('obj', 'default value');
if (ref $obj eq 'HASH') {
# ハッシュのリファレンスが得られた場合，
# ファイルがアップロードされた事を示す。
my $directory = $obj->{'directory'}; # 格納されたディレクトリ
my $filename = $obj->{'filename'}; # 格納されたファイル名
my $original = $obj->{'original'}; # オリジナルのファイル名(あれば)
my $mimetype = $obj->{'CONTENT_TYPE'}; # mime-type (あれば)
my $complete = $obj->{'complete'}; # データは全て保存されたか？
if (open FILE, $obj->{'path'}) {
# path メンバは directory とfilename を合わせたもの
}
}
elsif (ref $obj eq 'ARRAY') {
# ...
}
else {
# ...
}
use strict;
use Query();
# 空のリストを与える事で，この時点で何も行わないようにする
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
# GET 時にはファイルがアップロードされる事はないため
# 特に何も設定はしない。
Query::startup();
my $value = Query::get('key', 'default...');
# ...
}
else {
Query::startup({
directory => 'images', # images ディレクトリに
filename => 'uploaded.dat', # uploaded.dat という名前で保存。
uploadable => {
upfile => 1024 * 1024,
# input 要素の name 属性が "upfile" のものは
# 1024KiBytes までアップロード可能。
# 他の名前でアップロードされたものは，0bytesの制限がかけられて
# いるものとする。つまり1バイトも保存されないまま，
# Query.pm は STDIN からの読み込みを中断する。
},
no_unlink_limited_file => 1,
# 制限により中途半端に保存されたファイルも，
# Query.pm が削除しないようにする。
});
if (Query::is_interrupted()) {
# uploadable の制限に引っかかると，STDIN からの読み込みを
# 中断する。したがって，全ての input の値が取得できて
# いるとは限らない。
# 多くの場合，command の値は取得できていないはず。
# これは恐らく中途半端なファイル
my $upfile = Query::get('upfile');
if (defined $upfile &&
$upfile->{'complete'} == 0)
{
# 思った通り，中途半端だ ...
# 上では，自動では削除しないように設定したが，
# 削除したければここで削除すればよい。
unlink $upfile->{'path'};
}
else {
# interrupt の原因は他にある！？
# 悪意のハッカーが許可していない名前でアップロードを
# 試みた，等 ...
# とりあえず，今 Query が認知している全てのデータを
# ダンプしてみる
for (my ($key, $value) = Query::begin_enum();
defined $key && defined $value;
($key, $value) = Query::get_next() )
{
# 表示したり，保存したり ...
}
}
}
else {
my $upfile = Query::get('upfile', undef);
# ...
}
}
binmode(STDOUT);
print "Content-type: text/html\r\n\r\n";
print <<" -------------FORM-------------";
<form action="$cgi" method="post" enctype="multipart/form-data">
<fieldset>
<input type="file" name="upfile" />
: 1024KiBytes までアップロード可能
<input type="submit" name="command" value="submit" />
</fieldset>
</form>
-------------FORM-------------
Query::get() メソッドを呼び出す前に，Query.pm にいくつかの作業を行わせる必要があります。通常は何も気にせずに use Query; と記述するだけで作業が行われます (この時 Perl は自動で Query::import() を実行するからです)。何らかの事情により，起動直後に作業を行いたくない場合，
require 'Query.pm';
もしくは
use Query();
とし，後で
Query::startup();
とします。
Query.pm の挙動をコントロールするため，設定を与える事が出来ます。設定はハッシュのリファレンスを用います。
use Query ( {
directory => 'updir',
uploadable => 1024 * 1024,
} );
# 設定はハッシュに置く
my %preference = (
directory => 'updir',
uploadable => 1024 * 1024,
);
use Query();
Query::startup(\%preference);
# ハッシュのリファレンスを与える
スタートアップが開始した時に binmode(STDIN); が実行されます。つまり STDIN は "バイナリモード" になっています。これを防ぎたい場合は (そのような理由は思いつきませんが) 設定 no_binmode を使います。
以下に Query.pm の設定を示します。
use Query ({
require_list => [
'goods',
'faces',
],
uploadable => 1024 * 1024, # これはファイルのアップロードを受け付ける設定
});
reqire_list には，name 属性を列挙したリストのリファレンスを設定します。それらの値を get() サブルーチンで得た時に，必ずリストのリファレンスが得られる事を保証します。上記例により
<!-- HTML の例 -->
<form action="mycgi" action="post" enctype="multipart/form-data">
<input type="checkbox" name="goods" value="1" />goods1
<input type="checkbox" name="goods" value="2" />goods2
<input type="checkbox" name="goods" value="3" />goods3<br />
image 1 :<input type="file" name="faces" />
image 2 :<input type="file" name="faces" /><br />
<input type="checkbox" name="musics" value="rock" />rock
<input type="checkbox" name="musics" value="jazz" />jazz
</form>
my $goods = Query::get('goods');
my $faces = Query::get('faces');
my $musics = Query::get('musics');
$goods および $faces は必ずリストのリファレンスです。リストは空の場合もあります。対して $musics は undef か，スカラか，リストのリファレンスかも知れません。
1 以上を設定すると，$ENV{'QUERY_STRING'} を処理します。0 を設定すると $ENV{'QUERY_STRING'} を扱いません。デフォルトは 1 です。
use Query ({ getable => 0 });
# GET の場合，クエリを無視する。
1 以上を設定すると，標準入力からの入力を受け付け，処理します。0 を設定すると受け付けません。デフォルトは 1 です。
本来ならばファイルのアップロードも「POST メソッドによるアクセス」の一種ですが，Query.pm では postable と uploadable の設定はそれぞれ独立です。
1 以上のスカラ値を設定すると，ファイルのアップロードを受け付けます。この時，設定した値がアップロード可能なファイルのサイズになります。
input 要素 name 属性の値とサイズを対応させたハッシュのリファレンスを設定すると，それぞれのファイルの数やサイズを制限する事が出来ます。
デフォルトは 0 が設定されています。
use Query ( {
postable => 0,
# postable の設定と uploadable の設定は無関係。
uploadable => {
file1 => 1024 * 1024,
file2 => 2048 * 1024,
# <input name="file1" ... /> は1MiBytes
# <input name="file2" ... /> は2MiBytesまで保存される。
# もし他の名前でアップロードされたものがあれば，
# それらは保存されない。
},
} );
同じ値の name 属性を持つ input 要素が複数あり，複数のファイルがアップロードされた場合，それらファイルの総サイズが制限される事になります。例えば
use Query ( {
uploadable => {
upfile => 1000 * 1024,
},
} );
として upfile を 1000KiBytes に制限している時，
1.<input type="file" name="upfile" /><br /> 2.<input type="file" name="upfile" /><br /> 3.<input type="file" name="upfile" /><br />
上記の HTML で "1."，"2."，"3." それぞれのフィールドに 800Kibytes のファイルを指定すると，まず "1." のファイルは 800Kibytes 保存されます。"2." のファイルは 200Kibytes を読み込んだ後に制限に到達し，記録中のファイルは削除されます。"3." のファイルは保存されません。ただしブラウザのデータ送信の順番によって，結果は変わる場合もあります。
上記解説の "2." のように，読み出しの途中で制限に到達したため中途半端に記録されたファイルは，デフォルトでは自動で削除されます。削除しない設定は no_unlink_limited_file で行います。
アップロードされたファイルを保存するディレクトリを指定します。デフォルトは '.' (カレントディレクトリ) に保存されます。
directory で指定したディレクトリが存在しない場合，自動で生成する時のパーミッションを設定します。デフォルトは 0666 です。
use Query ( {
uploadable => 1024 * 1024,
directory => 'updir',
dir_perm => 0600,
} );
アップロードされたファイルを保存する時のファイル名を設定します。指定しない場合，デフォルトのサブルーチン Query::create_filename() によりファイル名が生成されます。
スカラ値を指定した場合，その値がそのまま使われます。
input 要素 name 属性と希望ファイル名を対応付けたハッシュのリファレンスを指定した場合，それらのファイル名が使われます。
use Query ( {
uploadable => 1024 * 1024,
filename => {
file1 => 'file1.dat',
file2 => 'file2.dat',
# <input name="file1" ... /> --> file1.dat として保存
# <input name="file2" ... /> --> file2.dat として保存
},
} );
サブルーチンのリファレンスを設定した場合，そのサブルーチンによりファイル名が決定されます。
use Query ( {
uploadable => 1024 * 1024,
filename => \&_my_create_filename,
} );
#-------------------------------------------------------
# _my_create_filename .. ファイル名を決定する
# @param [0] input 要素 name 属性の値
# @param [1] アップロード時のオリジナルのファイル名
# @param [2] mime-type
# @returns ファイル名を返す
sub _my_create_filename {
my $ext = '.dat'; # 拡張子
if ($_[1] =~ /(\.\w+)$/) {
$ext = $1;
}
my $seq = 1;
if (open SEQ, '+<', 'sequence.dat') {
$seq = <SEQ>;
seek SEQ, 0, 0;
print SEQ $seq + 1;
close SEQ;
} elsif (open SEQ, '>', 'sequence.dat') {
print SEQ '2';
close SEQ;
} else {
die 'cannot open sequence file.';
}
return sprintf("%08d%s", $seq, $ext);
}
ファイルを保存した際のパーミッションを設定します。デフォルトは 0666 です。
定義すると binmode(STDIN) を行いません。デフォルトでは定義されていません。
use Query ( {
no_binmode => 1, # 値は何でもよい
} );
定義すると，標準のファイル名生成ルーチン (Query::create_file()) を使う際に，拡張子を変換しません。
デフォルトでは定義されておらず，アップロードされたファイルのオリジナルのファイル名の拡張子が cgi と bat の場合は txt として，exe の場合は dat として保存します。
use Query ({
uploadable => { upfile => 1024*1024 },
no_interrupt => 1,
});
デフォルトでは，ファイルのアップロードを受け付けるために STDIN から読み込みを行っている最中に制限に到達すると，以降 STDIN からの読み込みを中断します。これによりファイル以外の input 要素も取得できない場合があります。設定 no_interrupt を定義する事で STDIN からの読み込みを継続し，他の input 要素の値やまだ制限に到達していない他のファイルを保存する事が出来ます。
Query モジュールの interrupt の仕組みは，巨大なファイルをアップロードされた時に無駄な CGI のプロセスを迅速に終了させ，通信ソケットがいち早く遮断できるようにする目的で試験的に組み込みました。テストした限り，この仕組みにより CGI のプロセスは早期に終了します。ただしファイルのアップロードは続き，通信ソケットは遮断されないようです。
長時間に亘る CGI の稼動が問題でない場合に限り，input 要素の値を確実に全て取得するために no_interrupt を定義しておく事が推奨されます。
use Query ({
uploadable => { upfile => 1024 * 1024 },
no_unlink_limited_file => 1,
});
デフォルトでは，制限に到達したために中途半端に保存されたファイルは自動で削除されます。get() で情報を得る事は出来ません。
設定 no_unlink_limited_file を定義する事でファイルを削除しません。この設定により残されたファイルの情報も，通常のファイルと同様に get() で取得する事が出来ます。この時，構造体の 'complete' メンバの値は 0 です。
my $upfile = Query::get('upfile');
if (defined $upfile) {
if ($upfile->{'complete'}) {
# 問題なし
} else {
# このファイルは中途半端に保存されている！
}
}
1 バイトも保存する事ができないように制限されたファイルは，そもそも保存が試みられません。
Query.pm のサブルーチンを示します。
Query::startup(); Query::startup( [hash reference] );
use Query(); として，Query.pm の読み込み時にあえて何も行わなかった場合，startup() ルーチンで最初の処理を行います。[hash reference] は設定を記述したハッシュのリファレンスです。戻り値はありません。
my $value = Query::get('key');
my $value = Query::get('key', 'default value');
CGI に入力された値を得ます。第 1 引数は input 要素 name 属性に設定された値を，第 2 引数は，値が入力されていない場合に返すデフォルトの値を設定します。CGI に入力された値を返します。URL-encode された文字列 (%xx) はデコードされています。
入力がファイルだった場合，ハッシュのリファレンスが得られます。
if (ref $value eq 'HASH') {
# $value->{'directory'} --> 保存先ディレクトリ
# $value->{'filename'} --> 保存されているファイル名
# $value->{'original'} --> オリジナルのファイル名
# $value->{'CONTENT_TYPE'} --> mime-type (無い場合もある)
# $value->{'path'} --> directory/filename
# $value->{'complete'} --> ファイルが完全に保存されたか
}
通常，'complete' メンバは常に 1 です。ファイルがサイズ制限により途中で保存されなくなった場合は自動で削除され，ハッシュは生成されません。設定 no_unlink_limited_file を用いた時のみ，このメンバが 0 になるハッシュが 1 つだけ生成される場合があります。
同じ name 属性での入力が複数存在する場合，リストのリファレンスが得られます。
if (ref $value eq 'ARRAY') {
foreach (@$value) {
# さらに中の値がハッシュのリファレンスである可能性もある。
# 同じ name 属性で複数のファイルがアップロードされたという事。
if (ref $_ eq 'HASH') {
# ...
}
}
}
同じ name 属性がいくつかある事が分かっている場合，設定 require_list を用いる事で，get() を行った時に確実にリストのリファレンスを得る事が保証されます。
my $path = Query::get_path('upfile');
'upfile' がファイルである事が判っている場合，このサブルーチンでパスを得る事が出来ます。ファイルでなかったか，値が入力されていない場合は undef が返ります。
同じ name 属性で複数のファイルがアップロードされた事が判っている場合，次のように配列の添え字を指定する事も出来ます。
my $path = Query::get_path('upfile', 1);
添え字を省略すると，0 とみなされます。
# 形式 1 (引数なし)
my $them = Query::clone();
my $value = $them->{'key'};
if (ref $value eq 'HASH') {
# ...
}
# 形式 2 (引数あり)
my $value = Query::clone('key');
if (defined $value && ref $value eq 'HASH') {
# ...
}
引数を渡さなかった場合，Query モジュールが内部で持つ構造体を完全にコピーします。コピー後の構造体の値を変更しても，Query モジュールが持つ値には影響を与えません。コピーされた構造体はハッシュのリファレンスとして返されます。
引数を渡した場合，個別のメンバを完全にコピーします。スカラか，リストのリファレンスか，ハッシュのリファレンスか，メンバが存在しない場合は undef を返します。
for (my $key = Query::begin_enum();
defined $key;
$key = Query::get_next() )
{
my $value = Query::get($key);
# ...
}
for (my ($key, $value) = Query::begin_enum();
defined $key && defined $value;
($key, $value) = Query::get_next() )
{
if (ref $value eq 'HASH') {
# ...
} elsif (ref $value eq 'ARRAY') {
# ...
} else {
# ...
}
}
input 要素 name 属性とその値を列挙します。上記例の前者のように戻り値からスカラのみ得る場合は，input 要素 name 属性が列挙されます。
my $filename = Query::create_filename( [name], [original file name], [mime-type] );
Query モジュールの設定で filename に何も設定しなかった場合に用いられるファイル名生成ルーチンです。第1引数は input 要素 name 属性の値，第2引数はアップロード時のオリジナルのファイル名，第3引数は mime-type を入力します。
このサブルーチンのリファレンスを filename に設定する事も出来ます。これはデフォルトの動作と等価です。
use Query();
Query::startup ( {
uplodable => 1024 * 1024,
filename => \&Query::create_filename,
} );
my $int = Query::is_interrupted();
設定 uploadable でサイズ制限を設けた場合で且つ設定 no_interrupt を用いていない場合，サイズ制限に到達すると途中で STDIN からの読み込みを中止します。その後，is_interrupted() は 1 を返すようになります。
以下のようにリストやハッシュのリファレンスを得た時，誤ってその内容を書き換えてしまう可能性があります。
one_routine();
another_routine();
sub one_routine {
my $upfile = Query::get('upfile'); # アップロードされたファイル
my $listref = Query::get('list'); # リストアップされた項目
delete $upfile->{'filename'}; # filename メンバを消してしまった！？
@{$listref} = (); # リストアップされた項目を消し去ってしまった！？
}
sub another_routine {
my $upfile = Query::get('upfile');
my $listref = Query::get('list');
print $upfile->{'filename'}; # おおっと！
print join(',', @{$listref}); # 空っぽ！
}
意図しない書き換えを防ぐには，clone() サブルーチンを使って構造体のディープコピーを得ます。
one_routine();
another_routine();
sub one_routine {
# 例えば，ここで clone を使う
my $upfile = Query::clone('upfile');
my $listref = Query::clone('list');
# 大丈夫。Query モジュールが保持しているデータには影響しない
delete $upfile->{'filename'};
@{$listref} = ();
}
sub another_routine {
my $upfile = Query::get('upfile');
my $listref = Query::get('list');
# 入力されたはずの値がきちんと表示される
print $upfile->{'filename'};
print join(',', @{$listref});
}
input 要素毎に異なるルーチンで保存ファイル名を生成するために，次のような設定が出来ればシンプルですが，現在は対応していません。
use Query ( {
uploadable => 1024 * 1024,
filename => {
upfile1 => \&_filename_for_upfile1,
upfile2 => \&_filename_for_upfile2,
upfile3 => \&_filename_for_upfile3,
}
} );
次のようにして対処が可能です。
use Query ( {
uploadable => 1024 * 1024,
filename => \&_filename_for_all,
} );
sub _filename_for_all {
my $input_name = $_[0];
if ($input_name eq 'upfile1') {
return _filename_for_upfile1(@_);
} elsif ($input_name eq 'upfile2') {
return _filename_for_upfile2(@_);
} elsif ($input_name eq 'upfile3') {
return _filename_for_upfile3(@_);
}
die 'invalid input name.';
}
この問題は設定 require_list の導入で解決しました。しかし require_list を適用していない input 項目については，依然，同様の問題があります。
HTML に同じ値の name 属性を持つ input 要素を複数記述しても，必ずしもリストが得られるとは限りません。この問題により，コードが多少混乱する可能性があります。
<input type="checkbox" name="cb" value="apple" /> apple <input type="checkbox" name="cb" value="banana" /> banana <input type="checkbox" name="cb" value="orange" /> orange
このチェックボックスを正常に処理するために，次のようなコードを書く必要があります。
my $cb = Query::get('cb');
if (not defined $cb) {
print 'no selection.';
}
elsif (ref $cb eq 'ARRAY') {
print 'your selection (multiple):';
print join (', ', @$cb);
}
elsif (ref $cb eq '') {
# 必ずしも複数の cb が選択され，リストが得られるとは限らない。
# このようにスカラが得られる可能性もある。
print "your selection (single): $cb";
}
次の作業を行う事で，取得できる値がリストのリファレンスである事を保証する事が出来ます。
my $query = Query::clone();
# これらがリストのリファレンスである事を保証する
foreach (qw(key1 key2 key3)) {
if (ref $query->{$_} ne 'ARRAY') {
my $temp = $query->{$_};
$query->{$_} = defined $temp ? [$temp] : [];
}
}
上記の処理を Query::startup() サブルーチンの最後に埋め込んでも構いません。その場合，上記のように変数 $query を用意するのではなく，内部データ %_the_data を直接操作するとよいでしょう (これが設定 require_list で行っている事です)。
巨大なファイルをいくつもアップロードされ続ける事で，DoS 攻撃を受けたり，ストレージの容量を不当に浪費する (これも広義の DoS か) 可能性があります。また，Query.pm が設けた制限をすり抜ける手段を見つけられるかもしれません。
ファイルをアップロードした時は，ファイル自身はもちろん，オリジナルのファイル名や mime-type も警戒すべき "外部からの入力" です。
例えば InternetExplorer がファイルをアップロードする場合，オリジナルのファイル名はドライブ名やフォルダ名を含む "絶対パス" です。フォルダ名はファイルをアップロードしたユーザにとって重大なプライバシーである場合もあります。不用意にオリジナルのファイル名を公表するべきではありません。
保存するファイル名に気をつけるべきです。拡張子 .cgi や .exe や .bat は，実行されてしまう可能性があります。標準のファイル名生成ルーチン Query::create_filename() ではいくつかの拡張子を安全なものに変換しています。
ファイル名を生成した際，不用意なスラッシュが含まれていると，想定していないディレクトリの重要なファイルを上書きし，破壊してしまう可能性があります。
HDD が潤沢でない場合，定期的にアップロード先ディレクトリの中身をクリーンアップするべきです。Query.pm はアップロード先ディレクトリのメンテナンスを行いません。
歩いて 5 分程度のコンビニエンスストアへ行くのに，余程の事情がない限り，自動車を使うべきではありません。Query.pm は決して軽いとは言えないモジュールです。
tkuri {at} fat.coara.or.jp
http://www.coara.or.jp/%7etkuri/
require_list 追加uploadable にスカラを設定した時，アップロード可能なファイルサイズを表すものに変更no_interrupt 追加no_unlink_limited_file 追加'complete' メンバ追加clone() サブルーチンに引数を渡せるように変更is_interrupted() 追加