Tips 目次

Tips (CGI&SSI)

Tips (Perl)

Tips (etc.)


Tips (CGI&SSI)

CGI と SSI に関する Tips


ブラウザの表示を変化させない CGI スクリプト(Status: 204 No Content)

HTTP の応答ステータスとして 204 を返すと、通常のブラウザは表示を変化させない。 CGI からは Status フィールドによって応答ステータスを指定できる。 同時に Set-Cookie が渡された場合、IE はクッキーを処理するが、 NN は処理しない様子。

サンプル CGI スクリプト (Perl)
#!/usr/bin/perl
print "Status: 204 No Content\n\n";

他の URI (URL) にジャンプする CGI スクリプト(Location フィールド)

HTTP の応答ステータスとして 30x と 応答ヘッダで Location フィールドに URI を渡すとブラウザは その URI にジャンプする(リダイレクション)。 Locatoin フィールドに渡す URI は、相対 URI だと処理できない ブラウザも存在するし、HTTP の規格(RFC2616)では 絶対指定することになっているので、絶対URIを指定のこと。 CGI から Location フィールドのみ出力すれば、 サーバが自動的に応答ステータス 302 (Found) を設定してくれるが、 別の応答ステータス(例えば 301 Moved Permanently)が必要なら、 Status フィールドで指定可能。 同時に Set-Cookie が渡された場合、IE もNN もクッキーを処理する様子。

サンプル CGI スクリプト (Perl)
#!/usr/bin/perl
print "Location: http://www.domain/foobar/\n\n";

最近の Apache は、セキュリティのため Location に対してデフォルトで Content-Type の charset に iso-8859-1 を指定する。 これが NN 4.7x でのバグによりジャンプ先で文字化けを起こすことがある。 charset をジャンプ先に合わせて設定するか、charset 指定をしないことにより、 文字化けの可能性を下げられるが、Content-Type フィールドを CGI 中で出力しても Apache は無視して、デフォルトの Content-Type と メッセージ本体を生成するようである。 Status フィールドも出力すると Content-Type および Content-Length、 メッセージ本体の指定が有効になる様子だが、規格からすると Content-Type の有無でメッセージ本体の有効か無効かを決める方が 良かったような気がする。 Status フィールドがあると Content-Type がないときは charset が 指定されないし、メッセージ本体の自動生成は行われない。

print "Status: 302 Found\n";
print "Contenet-Type: text/html; charset=EUC-JP\n";
print "Location: http://www.domain/foobar/\n\n";
print "<html><head><title>jump</title></head><body>文字化け回避</body></html>\n";

なお、CGI の規格では Location フィールドの値として、相対 URL 絶対パス (スキームやサーバ名、ポート番号を含まない/ から始まるパス)を 指定することが可能。このときサーバはそのパスにアクセスされたかのように 応答を返す(つまりリブラウザはダイレクトをしない)。 例えば、http://www.domain/foobar/test.cgi の cgi スクリプトが以下のとき、 サーバは http://www.domain/hogehoge/test.jpg にアクセスされたかのように 結果を返すように求められている(内部リダイレクト)。 Apache などはそのように動作するがサーバによっては実装されていないかもしれない。

サンプル CGI スクリプト (Perl)
#!/usr/bin/perl
print "Location: /hogehoge/test.jpg\n\n";

このとき、Apache では Status フィールドを出力してしまうと、 内部リダイレクトを行わずに、そのままブラウザに応答を返すので、 Location フィールドが RFC 違反になってしまうことに注意。 Status の有無に関わらず、Location の値によって内部リダイレクトを するかどうか決めた方が、便利だったように思う。 リダイレクト先が CGI スクリプトであれば、リダイレクト元の情報が 環境変数 REDIRECT_STATUS, REDIRECT_URL, REDIRECT_QUERY_STRING などに入る。


CGI のタイムアウトおよびブラウザの中断

クライアント(ブラウザ)の対応

サーバの対応

CGI スクリプトの対応


CGIスクリプト中で重い処理をバックグランド実行

重い処理を実行しながら、ブラウザの読み込みは早く完了させたい場合など。 fork(2)して子プロセス側でバックグランド処理、親プロセス側は終了してブラウザを解放する。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
my $pid = fork;
die unless defined $pid; # fork 失敗で異常終了
if($pid) { # 親プロセス
    print "Content-Type: text/html";
    # ブラウザへの出力処理
    exit; 
}
# 子プロセス
close STDOUT; # CGI出力完了(fork以前だと殺されてしまう)
# この後にバックグラウンド処理

サーバによるタイムアウトを回避

重い処理が終了するまで待ちたいがそのままではタイムアウトしてしまう場合など。 ただし、ブラウザが中断すると処理も中断される。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
sub handler {
    print "処理中です。\n";
    alarm 10;
}
$| = 1;
print "Content-type: text/plain\n\n";
print "処理を開始しました。\n";
$SIG{ALRM} = \&handler;
alarm 10;
#この間に重い処理
alarm 0;
print "処理を終了しました。\n";

サーバによるタイムアウトを回避&重い処理の保護

重い処理が終了するまで待ちたいがそのままではタイムアウトしてしまう場合など。 ブラウザが中断しても処理は中断しない。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
sub handler {
    print "処理中です。\n";
    alarm 10;
}
$| = 1;
print "Content-type: text/plain\n\n";
my $pid = fork;
die unless defined $pid; # fork 失敗で異常終了
if($pid) { # 親プロセス
    print "処理を開始しました。\n";
    $SIG{ALRM} = \&handler;
    alarm 10;
    wait;
    alarm 0;
    print "処理を終了しました。\n";
    exit;
}
# 子プロセス
close STDOUT;
#以下、長い処理

SSI における HTML 出力の中断

<!-- #exec cmd="./cmd.pl" -->以降のHTML出力を止めるcmd.plの例。 HTMLをパースしているサーバプロセス(SSIの親)を終了させることにより実現。 CGI中でも同様に強制終了は可能。ただしサーバログが残らない。 suEXEC や setuid などで、実効uidがサーバプロセスのと異なっているとkillが無効。

サンプルSSIスクリプト(Perl)
#!/usr/bin/perl
$|=1; # kill 時にバッファに残っていないようにオートフラッシュを設定
print "SSI 中断テスト:";
if( 条件 ) {
  print "中断します。\n";
  kill 'TERM', getppid; # 条件を満たすと以降の HTML 出力抑制
} else {
  print "続行します。\n";
  # 条件を満たさなければ以降の HTML 出力続行
}

CGI出力内容のコピーをファイルに出力

デバッグのためCGIスクリプトをあまり変更せずに出力のコピーをファイルに出力する。

サンプルSSIスクリプト(Perl)
#!/usr/bin/perl
# 以下、開始手続き
open SAVEOUT, '>&STDOUT'; # 標準出力のファイルハンドルを SAVEOUT に保存
my $pid = open STDOUT, '|-'; # fork が行われ、親プロセスの STDOUT が子プロセスの標準入力につながる
die unless defined $pid;
unless($pid) {
    open FILE, '>hogehoge.txt'; # 書き出したいファイルを開く
    print and print FILE $_ while(<STDIN>); # 親プロセスが出力した内容を子プロセス側でHTTPサーバとファイルの両方へ出力
    close FILE;
    exit; # 子プロセス終了
}
# ここに元のプログラム
# 以下、終了手続き
open STDOUT, '>&SAVEOUT'; # 標準出力を元に戻す
close SAVEOUT; # SAVEOUT を削除
wait; # 子プロセスの終了を待つ

CGIによるブラウザでのダウンロード

Content-Type フィールドが application/octet-stream のとき NN や IE は ダウンロード扱いする。 ただし IE は Content-Type フィールドよりも拡張子を優先して判断することが あるらしい。 Content-Disposition フィールド (RFC 2183) でファイル名の指定が可能。 ファイル名に日本語を直接書くのは多分 RFC 違反だが、Windows の IE や NN は Shift_JIS のファイル名を許容する。 Content-Length があれば、ダウンロード進行状況を示すプログレスバーが 機能するだろう。

サンプルCGIスクリプト
#!/usr/bin/perl
use strict;
my $file = "test.dat";
my $size = -s $file;
print <<__EOF__;
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=$file
Content-Length: $size

__EOF__
open FILE, '<', $file or die;
print while read FILE, $_, 1024;
close FILE;

サーバ上の特定フォルダ以下のファイルはダウンロード扱いしたければ、 .htaccess などに以下を指定する。

ForceType application/octet-stream

cgi スクリプトそのものをダウンロードしたければ以下も指定する。

RemoveHandler cgi

POST のサイズ制限

CGI.pm の $POST_MAX による制限では Apache はクライアントからの POST 要求を最後まで受け続ける。Apache の場合、LimitRequestBody ディレクティブを使用のが望ましい。それが無理な場合には、下記のように CGI スクリプトの親プロセスを強制終了させるとクライアントに送信を中断させることができるが、サーバは CGI 出力をクライアントに転送しない。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
kill 'TERM', getppid if $ENV{CONTENT_LENGTH} > 1000000;

Content-Encodig による gzip 圧縮

クライアントが Accept-Encoding フィールドで gzip または * を指定していれば、 gzip による転送データ量の圧縮が可能。 圧縮作業によるサーバ負荷が増える代わりに、 転送量減少によってネットワーク負荷が減る。 gzip 圧縮を行うときは、Content-Encodig フィールドで明示する。 Content-Length を使うなら当然、圧縮後のサイズを適用。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
print "Content-Type: text/plain; charset=EUC-JP\n";
if($ENV{HTTP_ACCEPT_ENCODING} =~ /\bgzip\b/i ||
  $ENV{HTTP_ACCEPT_ENCODING} =~ /\*/) {
    print "Content-Encoding: gzip\n\n";
    open GZIP, "|/bin/gzip -" or die;
    open STDOUT, ">&GZIP";
} else {
    print "\n";
}
print <<__EOF__;
gzip 圧縮のテスト。
__EOF__

なお、mod_gzip によって静的なページも動的ページも gzip 圧縮可能。 環境変数 SERVER_SOFTWARE に mod_gzip が含まれていれば、 モジュールがサーバに組み込まれているが、 CGI 出力も gzip 圧縮対象であるかどうかは設定に依存する。 mod_gzip が gzip 圧縮すると、DECHUNK されて、必ず Content-Length が使われる。


Tips (Perl)

Perlに関するTips


flock の使い方

flock によるファイルのロックは最も標準的な排他制御。
perl の flock は、環境により flock(2)、fcntl(2), lockf(3) のどれかで実装されている。
flock が使える OS は限られているが、ほとんどの UNIX は使用可能。
ただし一部の NFS などのファイルシステムでは動作が保証されないことがある。
標準的な UNIX 環境では flock は協調ロック (advisory lock) であり、flock がブロックするのは他の flock に過ぎない(flock されたファイルに別プロセスが書き込み可能)。
Windows の場合、perl の flock は 95/98 では未実装(致命的エラーを発生)、 NT/2000 では強制ロック (mandatory locking) らしい(flock されたファイルに別プロセスは書き込み不能)。
Mac については不明。
flock の操作として与えられるパラメータは共有ロック LOCK_SH (通常1), 排他ロック LOCK_EX (通常2), ロック解除 LOCK_UN (通常8) で、 LOCK_SH と LOCK_EX はノンブロッキング LOCK_NB (通常4) を OR できる。
LOCK_NB を指定しない限り、LOCK_SH や LOCK_EX はロックに成功するまで 戻ってこない。
LOCK_UN しなくても close すればロックは解除されるし、プロセスが SIGKILL などのシグナルで死んでもロックは解除される。
正常に機能する環境ならば最も便利なファイルロック方法かもしれない。
他の方法と違って、リトライ処理の必要がないし、大体は flock を呼び出した 順番にロックを獲得できる。
また、ロックしたプロセスが異常終了しても自動的にロックが解除されるので複雑な後処理が必要ない。
最近(多分 5.6.0 以降)の perl では flock 時にバッファをフラッシュするようになっている。
以下、WEBカウンタCGIでの例。

#!/usr/bin/perl
use strict;
use Fcntl qw(:DEFAULT :flock :seek); # 定数読み込み
sysopen FILE, "count", O_RDWR|O_CREAT, 0644 or die; # ファイルが存在しないときは作成される
#open FILE, '+<', "count" or die; # sysopen の代わりだが、予めファイルが存在しないとエラーになる
flock FILE, LOCK_EX or die; # ロック獲得
#sysseek FILE, 0, SEEK_SET; # 普通は不要
#seek FILE, 0, SEEK_SET; # open の場合だが、普通は不要
sysread FILE, $count, -s FILE; # カウントを読み込み
#read FILE, $count, -s FILE; # open の場合
chomp $count;
$count++;
sysseek FILE, 0, SEEK_SET;
#seek FILE, 0, SEEK_SET; # open の場合
#truncate FILE, 0; # 不適切
syswrite FILE, "$count\n"; # 1 回のシステムコールで書き込まれる
#print FILE, "$count\n"; # open の場合
#flock FILE, LOCK_UN; # close 時に解除されるので不要
#truncate FILE, tell FILE; # ファイルサイズが単調増加するなら不要
close FILE;

ファイルの読み書き位置は同一ファイル(iノード)に対してであっても ファイルディスクリプタごとに独立なので、flock 後の sysseek / seek は 通常は不要のはず。 ただし、dup(2) や fork(2) などで複製された場合、ファイルディスクリプタは共通なので sysseek / seek を必要とするケースもある。
上記のスクリプトのように書き込みを 1 回の syswrite で済ませると、どの時点でプロセスが死亡してもファイルの内容が失われる事はない。
truncate FILE, 0 を書き込み前に行うと、直後のプロセス死亡時にファイルサイズが 0 になる虞。
perl 5.6.0 より前では flock 時にバッファをフラッシュしないので、 syswrite を使わずに print を使った場合に flock で LOCK_UN すると、 print のバッファリングのためファイルへの書き込みが終っていないのに ロックを解除したことになりデータ破壊の虞 ($|=1 でオートフラッシュを設定すると回避可能)。
print で出力した場合、1024バイト未満であれば通常は 1 回のシステムコールで 書き出される可能性が高いとは思われるが、 その保証はないので sysopen / sysseek / sysread / syswrite の使用を推奨。


排他制御

排他制御のための手段として代表的なものに flock(2), open(2), symlink(2), rename(2), mkdir(2), link(2) がある。

#!/usr/bin/perl
use strict;
my $locked = undef;
$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub { die "killed by SIG".shift };
my_lock; # $locked == 1 になる
#この間に排他制御が必要な処理
my_unlock;
END {
  my_unlock if $locked;
}

このように排他制御が行なえるよう以下で my_lock と my_unlock の例を示す。 なお END ルーチンを定義しているのは、my_lock でロックを行なったあとに、 my_unlcok せずに die, exit などで終了した場合にロックを解除するため。 シグナルを受けてプロセスが異常終了するとロックされたままになるので、 シグナルハンドラを設定して die 経由で END ルーチンを呼び出している。

flock(2) による排他制御

排他処理の対象がファイルであるときはそのファイルを直接 flock する(前節のケース)手段もあるが、ここではロック用ファイルを作成する例。

use Fcntl qw(:flock);
my $lockfile = "lockfile";
sub my_lock {
    open FLOCK, '>', $lockfile or die;
    flock FLOCK, LOCK_EX or die; # flock が失敗することはまずあり得ない
    $locked = 1;
}
sub my_unlock {
    flock FLOCK, LOCK_UN; # なくてもよい
    close FLOCK;
    $locked = undef;
}

open(2) による排他制御

O_CREAT | O_EXCL フラグ付きで open(2)(perl では sysopen)を呼ぶと ファイルが存在しないときに限ってファイル作成し open は成功するが、 ファイルが既に存在すると open に失敗する。
そのため排他制御に用いることが可能。
sysopen は open(2) の後に fdopen(3) を呼ぶので、ファイルハンドルは open(fopen(3)で実装)と同様に扱える。
使える OS は限られているが、ほとんどの UNIX は使用可能。
ただし一部の NFS などのファイルシステムでは動作が保証されないことがある。
Windows や Mac については不明。
なお、perl の open (実体は fopen(3))ではファイルの作成とファイルの存在チェックを同時に行えないので排他制御に用いることはできない。

use Fcntl;
my $lockfile = "lockfile";
sub my_lock {
    for(my $i=0; $i<100; $i++) {  
        $locked = sysopen FILE, $lockfile, O_RDWR|O_CREAT|O_EXCL and last;
        select undef, undef, undef, 0.1; # 0.1 秒 sleep
    }
    die unless $locked; # 100回リトライ(約10秒)でもロックできなければ die
    close FILE;
}
sub my_unlock {
    unlink $lockfile;
    $locked = undef;
}

symlink(2) による排他制御

同一ファイルに対する複数のプロセスによる symlink(2) は、一つのプロセスしか成功しないのでロックに用いることが出来るが、使用できる環境に制限がある。
UNIX はほとんどの場合使える。 Windows や Mac は不明。

my $lockfile = "lockfile";
sub my_lock {
    for(my $i=0; $i<100; $i++) {  
        $locked = symlink $$, $lockfile and last;
        select undef, undef, undef, 0.1; # 0.1 秒 sleep
    }
    die unless $locked; # 100回リトライ(約10秒)でもロックできなければ die
}
sub my_unlock {
    unlink $lockfile;
    $locked = undef;
}

rename(2) による排他制御

同一ファイルに対する複数のプロセスによる rename(2) は、一つのプロセスしか成功しないのでロックに用いることが出来る。
あらかじめロック用ファイルを作成しておき、各プロセスはそのファイルを適当なユニークな名前に rename することによってロックを獲得する。
rename(2) は移動先ファイル名を作成した後に移動元ファイル名を削除するので両方のファイル名でアクセス可能な期間が存在するが、通常は問題にならないだろう。
ファイルの代わりにディレクトリでも構わない。
rename が使えない環境は UNIX, Windows, Mac を含めてほとんどないと思われるので汎用性が高い。

my $lockfile = "lockfile";
sub my_lock {
    for(my $i=0; $i<100; $i++) {  
        $locked = rename $lockfile, $lockfile.$$ and last;
        select undef, undef, undef, 0.1; # 0.1 秒 sleep
    }
    die unless $locked; # 100回リトライ(約10秒)でもロックできなければ die
}
sub my_unlock {
    rename $lockfile.$$, $lockfile;
    $locked = undef;
}

mkdir(2) による排他制御

mkdir による方法はファイルの代わりにディレクトリを使うだけで open(2) の方法と原理的には変わらないが、 mkdir は rename と同様に汎用性が高い。

my $lockdir = "lockdir";
sub my_lock {
    for(my $i=0; $i<100; $i++) {  
        $locked = mkdir $lockdir and last;
        select undef, undef, undef, 0.1; # 0.1 秒 sleep
    }
    die unless $locked; # 100回リトライ(約10秒)でもロックできなければ die
}
sub my_unlock {
    rmdir $lockdir;
    $locked = undef;
}

デッドロック

flock 以外の sysopen, symlink, rename, mkdir を使った方法ではロックファイル(またはリンクまたはディレクトリ)を残したままプロセスが終了していしまい、上記のスクリプトではデットロックが起こり得る。
よってこれらの実際に使う場合には、ロックファイルが作成された時間を調べて、あまりにも古ければロックを解除してしまう処理を入れる必要があるが、 そのときのロック解除も排他的に動作するように注意を払う必要がある。


実効 UID の切替え

root 権限がある場合、実 UID (real user ID) $<、実効 UID(effective user ID) $>、実 GID (real group ID) $(、実効 GID (effective group ID) $) の変更が 可能。 $< の参照は getuid(2)、$< への代入は setuid(2)、 $> の参照は geteuid(2)、$> への代入は seteuid(2)、 $< と $> への同時代入は setreuid(2) に相当する。 $( と $) はスペースで区切られた文字列として得られ、 1つ目の数字がそれぞれ getgid(2)、getegid(2) に相当し、 2つ目以降の数字群が共に getgroups(2) に相当する。 $( への代入は通常の数値で setgid(2) に相当するが、 $) への代入はスペース区切りの文字列で1つ目の数字で setegid(2)、 2つ目以降の数字群で setgroups(2) に相当する。 $( と $) への同時代入は setreuid(2) / setgroups(2) に相当する。

例えば、httpd が nobody 権限で動いていて、CGI スクリプトが root の setuid だとすると、以下の方法で一時的に権限 (effective UID, GID) を 他のユーザに切替えることが可能。

#!/usr/bin/perl
# 起動時は real UID ($<) が nobody、effective UID ($>) が root。
# 後で root 権限を取り戻せるように real UID を root に。
# 安全のため effective UID を nobody に。
($<, $>) = ($>, $<);
&sudo "foobar"; ユーザ foobar で実行
sub sudo {
    my $user = shift;
    my ($uid, $gid) = (getpwnam $user)[2, 3]; # ユーザ名から uid, gid を取得
    $> = $<; # root 権限を取り戻す
    ($(, $)) = ($gid, "$gid $gid"); # $user のグループ権限を獲得
    ($<, $>) = ($uid, $uid); # $user のユーザ権限を獲得
    # これ以降では $user のユーザー権限で動く
    # root 権限は完全に捨てている
}    

ただし、このプログラムだと sudo から戻ってきても foobar 権限のままに なってしまうので、sudo を複数回呼ぶつもりなら以下の通りにすると、 一時的にだけユーザ権限を切替えることができる。

sub sudo {
    my $user = shift;
    my ($uid, $gid) = (getpwnam $user)[2, 3];
    my $saved_uid = $>; # nobody 権限を保存
    my $saved_gid = $); # nobody 権限を保存
    $> = $<; # root 権限を取り戻す
    $) = "$gid $gid"; # $user のグループ権限を獲得
    $> = $uid; # $user のユーザ権限を獲得
    # この中では $user のユーザー権限で動く
    # ただし real UID が root であることに注意!!
    $> = $<; # root 権限を取り戻す
    $) = $saved_gid; # nobody 権限に戻す
    $> = $saved_uid; # nobody 権限に戻す
}

ただし、この方法では real UID を root にしておく必要があるので、 別ユーザ権限で動かす部分が複雑だったり外部プログラムを 呼び出すようなときはセキュリティホールになる可能性がある。 安全なのは以下の方法だが、fork を使うので少し重くなってしまう。

sub sudo {
    my $user = shift;
    my ($uid, $gid) = (getpwnam $user)[2, 3];
    my $pid = fork; # 子プロセス作成
    die unless defined $pid;
    if($pid) {
        waitpid $pid, 0; # 親は子の終了を待つだけ
    } else {
        $> = $<;
        ($(, $)) = ($gid, "$gid $gid");
        ($<, $>) = ($uid, $uid);
        # この中では $user のユーザー権限で動く
        # root 権限は完全に捨てている
        exit;
    }
}

perl の setuid スクリプト

ファイルパーミッションの setuid ビットは 04000。chmod u+s などで設定可能。 setgid ビットは 02000。chmod g+s などで設定可能。 ファイルシステムのマウントの仕方によっては setuid / setgid が無効(mount(8) の nosuid オプション)。

システムコール execve(2) がシェルスクリプトを実行する手順。 Linux などの場合、 シェバング行(shebang line, "shell bang" と "the whole shebang" の語呂合わせ?)が #!/bin/shell -opt であるシェルスクリプト /path.to/foobar が cd /path.to; ./foobar -flg のように起動されると、 execve(2) は /bin/shell -opt ./foobar -flag のように実行する。 この方式で、シェルスクリプトの setuid が有効な OS も 存在するらしいが、setuid の権限を得て /bin/shell 起動後、 /path.to/foobar を開く前に別ファイルに置き換えられると セキュリティホールになる虞がある。 そのため、Linux では、シェルスクリプトの setuid / setgid を無視する。 一方、最近の Solaris などはシェルスクリプトの setuid /setgid を有効に しているが、execve(2) が /path.to/foobar を 開いたファイルディスクリプタ(通常は /dev/fd/3。0=標準入力、 1=標準出力、2=標準エラー出力)を使って /bin/shell -opt /dev/fd/3 -flg のように実行するので、安全に setuid / setgid スクリプトが実行される。

Linux などのようにシェルスクリプトの setuid / setgid を無視する OS において setuid / setgid をエミュレートする機能が perl には存在する。 perl は引数に指定されたスクリプトファイルを開いた際に、 ファイルに setuid または setgid が設定されていると root に setuid された suidperl を呼び出す。 suidperl が root 権限を用いて権限を適切に変更する。 この仕組みのため、単に perl foobar.pl と実行したとしても foobar.pl に setuid / setgid が設定してあるとそれに従って権限が変更されることになる。 perl の setuid / setgid スクリプトについての詳細は perldoc perlsec を参照。

setuid / setgid の perl スクリプトなどで、実効 uid や 実効 gid が 実 uid や 実 gid と異なると perl は taint mode (汚染モード)で 実行される。 スクリプト中で実効 id と実 id を一致させて setuid / setgid 状態から 抜け出しても、taint mode は解除されない。 明示的に taint mode にするためには perl を -T オプションで 起動すれば良い。 taint mode では全ての外部入力データが汚染されているとみなされる。 これは PATH などの環境変数も例外ではない。

taint mode では、汚染されたデータを使って外部プログラムを 実行(system, ``, open によるパイプなど)しようとすると致命的エラーを発する。 例えば、単に system "ls -la"; を実行すると致命的エラーになる。 これは system 関数が ls を検索するため PATH を利用するのに、 PATH が汚染されているためである。 事前に $ENV{PATH}="/usr/bin:/bin" などとして PATH を除染する必要があるが、 他にもシェルが利用する BASH_ENV などの環境変数も除染する必要が あるかもしれない。 繁雑な除染作業を避けて system 関数を利用するには、実行するプログラムの 絶対パスを指定すれば、汚染チャックは行われないで済む。 ただし、単に system "/bin/ls -la"; としただけでは、perl は PATH 検索を行わないにも関わらず、PATH の汚染チェックをしてしまうかもしれない。 system "/bin/ls", "-la"; のように引数が2つ以上でかつ絶対パス指定であれば、 PATH の汚染チェックは行わない。または system {"/bin/ls"} "ls", "-la"; の ように実行するプログラムを絶対パス指定してもよい。 結論、setuid の perl スクリプトで system 関数を使うときは system {'/path.to/program'} "program", "opt1", "opt2"; の形式が無難。

taint mode では @INC に PERLLIB や PERL5LIB を含まないし、 '.' カレントディレクトリも含まないので、use, require, do を使うときは注意。 絶対PATHを指定するか、@INC に必要なパスを追加のこと。 taint mode による system 関数などの致命的エラーを避けるために perl を -U オプションで起動することは避けるべき。 -U オプションなしで致命的エラーが発生しないようにスクリプトを 修正するのが良い。 -U オプションが本当に意味あるのは、root がディレクトリを unlink したい ときだけだが、実際にはまず必要としないだろう(ファイルシステムに よっては root でもディレクトリの unlink は不可能)。


perl の system、exec、パイプ


fork, system, exec と出力バッファ

Perl 5.6.0 以降は fork, system, exec 時に全ての出力バッファをフラッシュするようになった。


SIGCHLDとwait

SIGCHLD が IGNORE だとシステムによっては wait が必ず失敗するようになる。 DEFAULT にしておくのが汎用性あるかも。


crypt

perl の crypt は crypt(3) で実装されている。 crypt(3) のアルゴリズムは主に 56-bit DES 方式と MD5 方式があり、 片方のみをサポートするシステムもあれば、両方をサポートするシステムもある。

56-bit DES 方式の場合、SALT は先頭2文字が使われ、 [a-ZA-Z0-9./] の64種(6ビット)が2つなので計12ビット4096通りになる。 PLAINTEXT は先頭8文字の下位7ビットのみ DES 鍵として使用(計56ビット)される。 8文字に満たない部分は null (0) で埋められる。 この DES 鍵で64ビットの 0 を25回暗号化する。 SALT はこの操作の中で利用される。 最終的な値64ビットを6ビットずつ11文字の文字列にする。 SALTの2文字を先頭につけた合計13文字が DES 方式の crypt の結果である。 crypt された結果に対応する PLAINTEXT & SALT の組合せはユニークであるらしい。

MD5 方式の場合、crypt の結果は $1$ の3文字で始まり SALT が次の $ まで続き、最後に暗号化された22文字の文字列が続く。 SALT の長さは 0 から 8 まで。PLAINTEXT は任意の長さが許容されるらしい。 ハッシュなので、複数の PLAINTEXT, SALT が同じ crypt 結果を返すことがあり得る。 SALT を決定するときは最大長8文字が有利であろう。

パスワードの照合の際は DES であるか MD5 であるかに関わらず暗号化文字列を そのまま SALT に渡すべきである。 SALT に2文字しか与えない場合には、DES の照合が扱えても MD5 形式 (あるいはもっと別の形式)への移行を強制するために DES 形式ではなく あえてMD5形式などの結果を返すシステムがあるかも知れないので、 照合のために SALT のみを取り出そうとするのは好ましくない。 DES/MD5 両用システムでは SALT が $1$ 形式なら MD5 形式で、 それ以外なら DES 形式で結果を返す。 SALTに不正な値を入れた場合も、エラーにならず結果は不定である。 例えば SALT が不正な 空文字列であるとき、crypt が結果として空文字列を 返す可能性があり、以下のように照合をしている場合、$encrypted が空だと照合の結果パスワードが一致したとみなされてしまう。

crypt($plaintext, $encrypted) eq $encrypted

これを意図しない場合は、次のように対処する必要がある。

$plaintext ne '' && $encrypted ne '' && crypt($plaintext, $encrypted) eq $encrypted

しかし本来 crypt(3) は SALT に不正な文字列を渡された場合、 結果として SALT そのままの文字列を返すべきではないように思う。

新たにパスワードを暗号化する場合、SALT の形式に注意するべきである。 DES 専用システムに $1$ 形式の SALT を与えると SALTとして不正な $1 を使う ために結果が不定になってしまう。 MD5 専用システムの中には DES 形式の SALT を与えた場合、 その SALT を用いて MD5 形式の結果を返すシステムもあるが 正常な結果を返さないシステムもあるので、 MD5 で crypt したい場合は $1$xxxxxxxx$ 形式の SALT を使うべきである。 以下は MD5 形式が使える時は 8 文字の SALT の MD5 形式で、 MD5 形式が使えないときは DES 形式で crypt を行なう例。

my @salt = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
$salt = crypt('foobar', '$1$ab$') eq '$1$ab$uAP8qWqcFs3q.Gfl5PkL2.' ?  '$1$'.join('', map($salt[rand @salt], 1..8)).'$' : $salt[rand @salt].$salt[rand @salt];
$encrypted = crypt $plaintext, $salt;

初めての rand は srand を呼ぶ。srand は /dev/urandom などからシードを得るはず。 以下は、crypt の実装状況を調べるスクリプト。

$plaintext = 'foobar';
$salt = 'ab';
$DES = 'abVbJXzHUY99s';
$MD5 = '$1$ab$uAP8qWqcFs3q.Gfl5PkL2.';
printf "DES comparison: %s\n", crypt($plaintext, $DES) eq $DES ? 'OK' : 'NG';
printf "MD5 comparison: %s\n", crypt($plaintext, $MD5) eq $MD5 ? 'OK' : 'NG';
$encrypted = crypt $plaintext, $salt;
$mes = $encrypted eq $DES ? 'DES' : $encrypted eq $MD5 ? 'MD5' : "unknown($encrypted)";
print "crypt with a traditional salt [a-zA-Z0-9./]{2}: $mes\n";

ファイルの追加書き込み

open / close / print / read などは stdio(3) で実装されている。
$|=1 とすると print は出力後に自動的にバッファをフラッシュする(おそらく fflush(3) を呼ぶ)だけで、複数の write(2) が呼び出される可能性がある。
syswrite は単一の write(2) を呼ぶ。
write(2) は追加書き込時は、inode をロックし、ファイルポインタを末尾に移動してから書き込むので、他の write(2) と排他的に動作する。
よって複数のプロセスから同一ファイルへ追加書き込み時に syswrite を使えば、ファイルの整合性を保てるので、ファイルロックを必要としない場合もありうる。

サンプルスクリプト(Perl)
#!/usr/bin/perl
$message = localtime().": foobar.\n";
open LOG, ">>log.txt" or die;
syswrite LOG, $message;
close LOG;

4 引数 select によるタイムアウト

4 引数 select を使う時はバッファー入出力を行なう read や <> 演算子などを避けるのが無難。

サンプルスクリプト(Perl)
#!/usr/local/bin/perl
use strict;
use Socket;
my $host = "www.yahoo.co.jp";
my $path = "/";
my $port = getservbyname 'www', 'tcp';
my $timeout = 4;
my $proto = getprotobyname 'tcp';
socket SOCKET, PF_INET, SOCK_STREAM, $proto or die;
my $addr = inet_aton $host;
my $sin = sockaddr_in $port, $addr;
connect SOCKET, $sin or die;
binmode SOCKET;
select((select(SOCKET), $|=1)[0]); # これは 1 引数の select
print SOCKET "GET $path HTTP/1.0\x0d\x0a\x0d\x0a";
my $data = '';
my $rin = '';
my $rout;
vec($rin, fileno SOCKET, 1) = 1;
die unless select $rout=$rin, undef, undef, $timeout;
while(read SOCKET, my $buffer, 1024) {
    die unless select $rout=$rin, undef, undef, $timeout;
    $data .= $buffer;
}
close SOCKET;
my($header, $body) = split /\x0d\x0a\x0d\x0a/, $data, 2;

perl のサブルーチンにおける仮引数と実引数の扱い

perl のサブルーチン(関数)の仮引数 @_ の各要素は呼出元の実引数の エイリアスなので、実引数が変数の場合、 仮引数を書き換えれば呼出元の変数が書き換えられる。 これは grep や map, sort, foreach の仮引数でも同様。

sub test1 { $_[0] = 2 }
$a = 1;
test1($a);
print $a; # 2

関数の実引数はリストとして評価されてから仮引数に渡されるので、 ある変数を含む式が実引数に指定された場合、仮引数は式の評価された値ではなく その変数のエイリアスとなるケースがあることに留意。

test1($a=10);
print $a; # 2
sub test2 { local $, = ' '; print @_, "\n" }
test2($a=0, $a, $a+=5, $a++, ++$a, $a=10); # 10 10 10 5 10 10

変数に対する代入演算子および単項前置のインクリメントやデクリメントの 評価結果は変数そのものということか。 単項後置のインクリメントやデクリメントの結果は変数操作前の値なので、 評価値は変数そのものにはならない。 これらの性質を利用して chomp 相当の関数を作成してみた。

sub my_chomp {
  return 0 if !defined $/ || ref $/;
  my $pat = $/ eq '' ? '\n+\z' : $/.'\z';
  my $num = 0;
  s/$pat// and $num += length $& foreach @_ ? @_ : $_;
  return $num;
}
my_chomp $a, @a, %a; # chomp $a, @a, %a;
my_chomp; # chomp;

Perl 5.6.0 より前ではハッシュについては各要素のエイリアスは 作成されないのでうまくいかない。 Perl 5.6.0 以降ではハッシュが渡された時にキーが条件にマッチしても、 元のハッシュのキーは変更されないというのは chomp と同じだが、 返値となる削除された文字数にはカウントされてしまうというところが chomp と異なってしまう。以下で回避可能。

$num = my_chomp values %a; # $num = chomp %a;

テキストファイル中の行を逆順に並べ換えたファイルを作成

行単位のログファイルなどで行を逆順に並べ換えたファイルを作成する例。 アルゴリズムとしては読み込みは先頭から順番に行ない、 ある程度の量を読んだら並び換えたときに存在するべき位置に書き込んでいくので、 どんな行数の多いファイルを処理してもメモリ使用量は少ない。

#!/usr/bin/perl
use strict;
sub reverse_file {
    my($infile, $outfile) = @_;
    open IN, '<', $infile or die;
    open OUT, '>', $outfile or die;
    my $filesize = -s IN;
    my $buffer = '';
    while(<IN>) {
        $buffer = $_ . $buffer;
        next if length $buffer < 10000; # 適切なサイズを指定のこと
        seek OUT, $filesize - tell, 0; # あるべき位置へ移動
        print OUT $buffer;
        $buffer = '';
    }
    seek OUT, 0, 0;
    print OUT $buffer;
    close IN;
    close OUT;
}
reverse_file 'original.lst', 'reverse.lst';

複数プロセスを同期を取って同時に実行

排他処理のテストなどのために、 複数プロセスに同時に処理を実行させるプログラム。

#!/usr/bin/perl
use strict;
my $max = 10; # 同時に実行させるプロセス数
setpgrp or die; # 独立したプロセス・グループを生成
my $pid;
for(my $i=0; $i<$max; $i++) {
    defined($pid = fork) or die;
    last unless $pid;
}
if($pid) {
    sleep 3; # 子プロセスが STOP するのに十分な時間
    kill 'CONT', -$$;
    exit;
}
# 以下、子プロセス
kill 'STOP', $$; # 以下、同時に実行したい処理
print "$$: This is a test.\n";

Tips (etc.)

その他のTips


Unix上でWindowsの自己解凍型LZHの作成

UNLHA32.DLL 1.52a の WinSFX32 形式で作成した自己解凍書庫の先頭の 23,040bytes を切り出して "WinSFX32" というファイル名で保存。 LZH 書庫のヘッダ形式はレベル0,1,2の3種類あり、 自己解凍ルーチンはレベル2にのみ対応。 LHa for UNIX はデフォルトでレベル1を使うと書いてあるので、圧縮時に明示的にレベル2を使用するように指定する(lha -a2)。 UNIX 上でレベル2で圧縮したLZH書庫を切り出したコードに連結すると、 Windows 上で正常に自己解凍できる。

サンプルCGIスクリプト(Perl)
#!/usr/bin/perl
$| = 1;
$WinSFX32 = "/path.to/WinSFX32"; # 切り出した自己解凍ルーチン
$DownLoad_Path = "/path.to/directory/"; # 圧縮したいファイルのあるディレクトリ
$DownLoad_File = "hogehoge"; # 圧縮したいファイル
print "Content-type: application/octet-stream\n";
print "Content-disposition: attachment; filename=hogehoge.exe\n\n";
system "/bin/cat $WinSFX32";
chdir $DownLoad_Path;
system "/usr/local/bin/lha a2q - $DownLoad_File";

メールの送信 (sendmail)

sendmail はメールアドレスの間違いなどでメールが配送できなかった場合、 -f で指定したアドレス宛にエラーメールを送信して正常終了する。 エラーメールを -f で指定したアドレスに送信できない場合は、 サーバの管理者(postmaster)宛にエラーメールを送信してやはり正常終了する。 最低限、open と close のエラーチェックが必要。 open と close の返り値が真であれば、メールが宛先に配送されたか エラーメールが差出人または管理者に配送されたことをある程度期待できる。 sendmail の終了ステータスが EX_TEMPFAIL (通常 75)のときは、 配送は行われずにキューに入ったことを示す。 キューのメールはデーモンによって後で再送が試みられるのが普通。 以下、sendmail を用いたメール送信のサンプル。

#!/usr/bin/perl
use strict;
my $sendmail = '/usr/sbin/sendmail';
my $from = 'foo@xx.jp';
my $return = 'bar@xx.jp';
my $to = 'aaa@yy.jp';
my $cc = 'bbb@yy.jp';
my $bcc = 'ccc@zz.jp';
my $subject = 'test';
my $body = "Dear aaa\n\nHello world!";
#$SIG{PIPE} = 'IGNORE'; # 最近の Apache の CGI では不要
open MAIL, "| $sendmail -i -t -f $return" or die; # エラー判定
print MAIL <<__EOF__;
From: $from 
To: $to
Cc: $cc
Bcc: $bcc
Subject: $subject

$body
__EOF__
if(close MAIL) { # エラー判定
    print "succeeded.\n";
} elsif($? == 75<<8) {
    print "queued.\n"; # キューに落ちた場合
} else {
    print "failed. (", $?>>8, "/", $?&255, ")\n";
}

sendmail でよく使うオプションについて。


行区切り、改行、復帰などなど


強制ロック (mandatory locking)

Linux において強制ロックを行なうにはファイルシステムが mand オプション付きでマウントされていること、 ファイルは setgid ファイルであること、 fcntl によってロックすることが必要である。

$ df .
Filesystem           1k-blocks      Used Available Use% Mounted on
/dev/sdb1             35001508        40  33223476   1% /mnt/disk2
$ mount -l | grep /mnt/disk2
/dev/sdb1 on /mnt/disk2 type ext2 (rw,mand) [/mnt/disk2] #mand オプション付きでマウントしておく
$ ls -l test.txt #ロック対象のテストファイル
-rw-r--r--    1 foobar   users           0 Aug 14 15:00 test.txt
$ chmod g+s test.txt #強制ロックを有効化
$ ls -l test.txt
-rw-r-Sr--    1 foobar   users           0 Aug 14 15:00 test.txt
$ cat test1.pl #ロックを行なうプログラム
use Fcntl;
my $F_WRLCK = pack "sslll", F_WRLCK, 0, 0, 0, 0;
open FILE, ">test.txt" or die "can't open!: $!";
fcntl FILE, F_SETLKW, $F_WRLCK or die "can't lock!: $!";
print FILE "mandatory locking.\n";
sleep 10;
close FILE;
$ cat test2.pl #単にopenして書き込むプログラム
open FILE, ">test.txt" or die "can't open!: $!";
print FILE "no locking.\n";
close FILE;
$ perl test2.pl #通常は正常に実行
$ cat test.txt
no locking.
$ perl test1.pl &
$ perl test2.pl #test1.pl が強制ロック中に実行してみる
can't open!: Resource temporarily unavailable at test2.pl line 1. #強制ロックのため open が失敗する
$ cat test.txt
mandatory locking.

内容に関する間違いの指摘を歓迎します。 <admin2 AT bioinfo.jp> まで御連絡下さい。

最終更新日:2004年02月14日

[Taro's Note]