perlipc - Perl のプロセス間通信 (シグナル, fifos, パイプ, safe subprocesses, ソケット, セマフォ)
Perlの基本的なIPC機能は、古きよきUNIXのシグナル、名前付きパイプ、 パイプ、Berkeley ソケットルーチン、 SysV IPCコールから構成されて います。これら各々ははっきりと異なる状況で使われます。
Perlは単純なシグナルハンドリングモデルを使っています: %SIGという ハッシュは、ユーザーがインストールしたシグナルハンドラーの名前、 もしくはハンドラーに対するリファレンスを保持します。これらのハン ドラーは、起動されたシグナルの名前を引数として呼び出されます。シ グナルはcontrol-C や control-Z のような特定のキーボードシーケン スで意識的に生成することもできますし、他のプロセスがシグナルを送 ることもあります。あるいは子プロセスが終了したとか、プロセスがス タックを使いきった、ファイルサイズ制限に引っ掛かったといった特殊 なイベントが発生したときに、カーネルが自動的にシグナルを発生させ ることもあります。
例えば割り込みシグナル(interrupt signal)をトラップするには、以下 の例のようにハンドラーを設定します。こうすることで、自分のハンド ラーの中を使うことができます。私たちがどのように認識しているかは、 グローバル変数に設定した後で例外を引き起こすというものです。これ は、ほとんどのシステム上ではライブラリ、とくにメモリ割り付けや入 出力に関するものは再入可能ではないためです。これは、あなたのハン ドラーが理論的にはメモリーフォールトやそれに続くコアダンブを引き 起こす可能性があるということです。
sub catch_zap {
my $signame = shift;
$shucks++;
die "Somebody sent me a SIG$signame";
}
$SIG{INT} = 'catch_zap'; # モジュールの中で失敗する可能性がある
$SIG{INT} = ¥&catch_zap; # 最善の戦略
あなたの使っているシステムにおけるシグナルの名称は kill -l に よってリストアップされます。あるいはコンフィグモジュールから取得
することもできます。名前を得るための番号によって添え字づけされる
@signame というリストと番号を得るための名前によって添え字づけさ れる
%signoというテーブルをセットアップします。
use Config;
defined $Config{sig_name} || die "No sigs?";
foreach $name (split(' ', $Config{sig_name})) {
$signo{$name} = $i;
$signame[$i] = $name;
$i++;
}
ですから、17番のシグナルとSIGALRMが同一であるかどうかは以下のようにして チェックできます:
print "signal #17 = $signame[17]¥n";
if ($signo{ALRM}) {
print "SIGALRM is $signo{ALRM}¥n";
}
ハンドラーとして'IGNORE' や 'DEFAULT'といった文字列を代入 することも選択できます。これらのハンドラーは、perlがシグナルを破
棄させるようにしたりデフォルトの動作を行うようにさせるものです。
ほとんどのUNIXプラットフォームでは、CHLD(CLDの場合もあり) シグナルは'IGNORE'の値に対応するような特別な振る舞いをします。 そのようなプラットフォームでは'IGNORE'に$SIG{CHLD}を 設定することによって、親プロセスがwait()に失敗したようなときに ゾンビプロセスができることを防ぎます(子プロセスは自動的に
刈り取られます)。$SIG{CHLD}をC<'IGNORE'>を設定して
wait()を呼び出すことによって、このようなプラットフォームでは
-1が通常返されます。
KILLシグナルやSTOPシグナル(TSTPではない)のような幾つかのシグナル は、トラップすることも無視することもできません。
一時的にシグナル を無視するための戦略はlocal()文を使うというものです。これはその
local()文を囲むブロックから出たときに、自動的に元の状態に復帰し
ます。(local()による値は ブロックの内側から呼び出された関数に
“引き継がれる”(inherited)ことを忘れないでください)。
sub precious {
local $SIG{INT} = 'IGNORE';
&more_functions;
}
sub more_functions {
# 割り込みはまだ無視されます…
}
負のプロセスIDに対してシグナルを送ることは、UNIXプロセスグループ 全体にシグナルを送ることになります。以下のコードは、カレントのプ ロセスグループに属する全てのプロセスにhang-upシグナルを送出しま す(そして、$SIG{HUP}にIGNOREを設定するので、自分自身をkillするこ とはありません)。
{
local $SIG{HUP} = 'IGNORE';
kill HUP => -$$;
# snazzy writing of: kill('HUP', -$$)
}
この他の興味深いシグナルは、シグナル番号ゼロです。これは実際には 他のプロセスに影響を及ぼすことはありませんが、UIDが生きているの か、あるいは変更されたのかのチェックを行います。
unless (kill 0 => $kid_pid) {
warn "something wicked happened to $kid_pid";
}
単純なシグナルハンドラーには無名関数を使いたくなるかもしれません:
$SIG{INT} = sub { die "¥nOutta here!¥n" };
しかしこれは、自分自身を再インストールする必要があるような、もっ
と複雑なハンドラーに対しては問題になる可能性があります。Perlのシ
グナル機構は現在のところCライブラリの signal(3) 関数に基づいた
ものなので、関数が“ぶっ壊れた”ような、つまり、より新しくて信頼 性のある
BSD形式やPOSIX形式ではなく古くて信用できない SysV方式の
振る舞いをするようなものシステムで実行するような不運な立場になる
かもしれません。そのため、以下のようにシグナルハンドラーを書いて
人を守っているものを見るでしょう:
sub REAPER {
$waitedpid = wait;
# loathe sysV: it makes us not only reinstate
# the handler, but place it after the wait
$SIG{CHLD} = ¥&REAPER;
}
$SIG{CHLD} = ¥&REAPER;
# forkなどのことを行います…
あるいはもっと念入りに:
use POSIX ":sys_wait_h";
sub REAPER {
my $child;
while ($child = waitpid(-1,WNOHANG)) {
$Kid_Status{$child} = $?;
}
$SIG{CHLD} = ¥&REAPER; # still loathe sysV
}
$SIG{CHLD} = ¥&REAPER;
# forkなどのことを行います…
UNIXでは、シグナルハンドラーはタイムアウトのためにも使われます。
eval{}ブロックの中では安全に保護されいる間に、alarmシグナルを
トラップするためにシグナルハンドラーを設定して、その後で解放され
る秒数をスケジューリングします。それからブロッキング操作を試して、
それが完了したらC<eval{}>ブロックを抜ける前にalarmをクリアーしま
す。設定した時間が経ってしまった場合には、他の言語におけるlongjmp()
やthrow()を使ったときと同じようにブロックを抜けるために die()を
使います。
例を挙げましょう:
eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm 10;
flock(FH, 2); # 書き込みロックをブロックする
alarm 0;
};
if ($@ and $@ !‾ /alarm clock restart/) { die }
より複雑なシグナル処理のためには、標準のPOSIXモジュールを確かめ るとよいかもしれません。嘆かわしいことにこれはほとんどアンドキュ メントな状態ですが、Perlのソース配布キットにあるF<t/lib/posix.t> というファイルには幾つかのサンプルがあります。
名前付きパイプ(しばしば FIFOとして参照されます)は、同じマシン上 でのプロセス間通信のための古い UNIX IPC 機構です。これは通常の無 名パイプの接続と同様に動作しますが、ファイル名を使ってプロセスの ランデブーが行われ、関連づける必要がないという点が異なります。
名前付きパイプを生成するには、UNIXコマンドのmknod(1)を使うか、一 部のシステムでは
mkfifo(1)を使います。これらはあなたの通常パス (normal
path)に置くことはできません。
# system の戻り値は逆向きなので、||ではなく&&を使います
#
$ENV{PATH} .= ":/etc:/usr/etc";
if ( system('mknod', $path, 'p')
&& system('mkfifo', $path) )
{
die "mk{nod,fifo} $path failed";
}
fifoは、あるプロセスをそれとは関係ない別のプロセスに接続したいと きに便利です。fifoをオープンしたとき、プログラムはもう一方の端点 に何かが置かれるまでブロックされます。
たとえば、.signatureというファイルを、もう一方の端点に Perlプ ログラムが置かれている名前付きパイプに接続したいとしましょう。こ のとき、任意のプログラムが任意の時点で(メイラー、ニューズリーダー、 finger プログラムなどのように)そのファイルを読み出そうとしますか ら、読み出しプログラムはブロックをしてからあなたのプログラムが新 しいシグネチャーを提供するようにしなければなりません。誰か(もし くは何か)が間違って私たちのfifoを削除したりしないかどうかを監視 するために -pという pipe-cheching ファイルテストを使用します。
chdir; # ホームディレクトリへ戻る
$FIFO = '.signature';
$ENV{PATH} .= ":/etc:/usr/games";
while (1) {
unless (-p $FIFO) {
unlink $FIFO;
system('mknod', $FIFO, 'p')
&& die "can't mknod $FIFO: $!";
}
# next line blocks until there's a reader
open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
print FIFO "John Smith (smith¥@host.org)¥n", `fortune -s`;
close FIFO;
sleep 2; # dup シグナルを無視するため
}
シグナルを取り扱うPerlプログラムをインストールすることによって、 あなたは二つの危険性に直面することになります。 第一に、再入可能なライブラリ関数を備えたシステムは数少ないこと。 Perlがある関数(malloc(3)やprintf(3)など)を実行中にシグナル割り込みが あったとすると、あなたのシグナルハンドラーは同じ関数を 再度呼び出し、結果として予測のつかない動作になる可能性があります。 第二に、Perl自身も最低レベルにおいては再入可能になっていないという ことです。Perlが自分の内部構造を操作しているときにシグナル割り込みが あったとすると、これもまた予測のつかない動作になるでしょう。
あなたの取りうる手段が二つあります: 偏執狂的になるか現実的になるかです。
偏執狂的アプローチは、あなたのシグナルハンドラーの中でできるだけ
少ないことを行うというものです。既に値をもって存在している整数変数
に値を設定してリターンします。これは単にリスタートするような
遅いシステムコールの中にいるとき
には助けになりません。これはつまり、ハンドラーの外にlongjump(3) するにはdieする必要があるということです。これは
本当の偏執狂というのにはちょっとおおげさですが、ハンドラー中で
dieを排除します。 現実的なアプローチは“リスクがあるのは分かってるけどさ、便利な
らいいじゃない”というもので、シグナルハンドラー中で行いたいことを
全て行い、コアダンプを掃除する準備をしてから再度行うというものです。
IPCのためにopen()を使う
Perlの open()文は、その第二引数でパイプシンボルを前置するか末尾
に付加することによって、一方向のプロセス間通信のために使うことが
できます。以下の例は、書き込みを行いたい子プロセスを起動させるや り方です:
open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
|| die "can't fork: $!";
local $SIG{PIPE} = sub { die "spooler pipe broke" };
print SPOOLER "stuff¥n";
close SPOOLER || die "bad spool: $! $?";
そして以下の例はそこから読み込みを行いたい子プロセスを起動する方 法です:
open(STATUS, "netstat -an 2>&1 |")
|| die "can't fork: $!";
while (<STATUS>) {
next if /^(tcp|udp)/;
print;
}
close STATUS || die "bad netstat: $! $?";
特定のプログラムの一つが@ARGVにあるファイル名を期待しているPerl スクリプトであっていいのなら、賢いプログラマーは以下のように書く こともできます:
% program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
そしてそれを呼んだシェルには関係なく、このPerlプログラムはf1 というファイル、cmd1というプロセス、標準入力(この例では tmpfile)、f2というファイル、cmd2というコマンド、f3と いうファイルから読み込みを行います。すごくいいよね?
読み込みのためのパイプを開くために、backticsを使って同じことがで きることに気がつくかもしれません:
print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
die "bad netstat" if $?;
その推測は表面的には正しいことのように見えるかも知れませんが、一 度にメモリーにすべてを読み込む必要がないので、一度にファイルの一 行や一レコードを処理するには(最初の例のほうが)より効率的なのです。 同様にプロセス全体の制御を与えるので、あなたが望めば早い時期に子 プロセスをkillすることができます。
open()とclose()の戻り値をチェックするときは注意してください。パ
イプに対して書き込みをしたのなら、SIGPIPEをトラップすべきです。
そうしなければ、存在しないコマンドに対するパイプを起動したときに
起こることについて考え込むことになるでしょう: open()はほとんどの
場合成功すると見込まれるでしょうが(これはfork()の成功だけを反映
します)、あなたの出力はその後で壮観に(spectacularly)失敗するでし
ょう。コマンドは、実際にはexec()が失敗している別のプロセスで実行
されているので、Perlはコマンドがうまく動いているかどうかを知るこ
とはできません。したがって、偽のコマンド(bugus command)の読み手 はすぐにend
of file を受け取り、偽のコマンドに対する書き手は事前
に取り扱っておくべきシグナルを発生させるでしょう。以下の例を考え
てみましょう:
open(FH, "|bogus") or die "can't fork: $!";
print FH "bang¥n" or die "can't write: $!";
close FH or die "can't close: $!";
That won't blow up until the close, and it will blow up with a SIGPIPE. To catch it, you could use this:
$SIG{PIPE} = 'IGNORE';
open(FH, "|bogus") or die "can't fork: $!";
print FH "bang¥n" or die "can't write: $!";
close FH or die "can't close: status=$?";
メインプロセスと子プロセスで同じファイルハンドル STDIN, STDOUT, STDERR を共有します。両方のプロセスが同時にそれらのハンドルにア クセスしようとした場合、おかしな事が発生する可能性があります。あ なたは子プロセスのためにファイルハンドルのクローズと再オープンに したいと考えるかもしれません。これは、open()を使ってパイプをオー プンすることによって対処することができますが、一部のシステムにお いては子プロセスはその親プロセスよりも長生きすることはできません。
以下のようにしてコマンドをバックグラウンドで実行することができます:
system("cmd &");
コマンドの STDOUTとSTDERR (とあなたの使うシェルによってはSTDINも) はその親プロセスのものと同一になります。double-fork の実行によっ て、SIGCHLDを捕捉する必要はありません(詳しくは後述します)。
一部の場合(例えばサーバープロセスのスタート)、親プロセスと子プロセス を完全に無関係のものにしたいことがあるでしょう。これはしばしば daemonizationと呼ばれます。礼儀正しいデーモンはルートディレクトリ にchdir()(そのため実行ファイルのあったディレクトリを含む ファイルシステムのアンマウントを邪魔することが ありません)し、その標準ファイルディスクリプターをF</fdev/null>に リダイレクトします。
use POSIX 'setsid';
sub daemonize {
chdir '/' or die "Can't chdir to /: $!";
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null'
or die "Can't write to /dev/null: $!";
defined(my $pid = fork) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}
fork()はプロセスグループリーダー(もしそうならsetsid()は失敗するでしょう)で
ないことを保証するために setsid()の前になければなりません。
あなたの使っているシステムがsesid()関数を持っていないのであれば、
/dev/ttyをオープンしてTIONCNOTTY ioctl()を代わりに使います。 詳しくはtty(4)
非UNIXユーザーはあなたのOSのProcessモジュールをチェックして 他の解決策を探しましょう。
もう一つの、IPCのための興味深いアプローチはマルチプロセスになっ
てそれぞれの間で通信を行う単一のプログラムを作るというものです。
open()関数は "-|" や "|-" といったファイル引数を非常におも しろいことを行うために受け付けます:
これはあなたがオープンしたフ
ァイルハンドのための子プロセスをfork()するのです。その子プロセス
は親プロセスと同じプログラムを実行します。これはたとえば、仮定さ
れたUIDやGIDのもとで実行する際に安全にファイルをオープンするのに
便利です。マイナスに対するパイプをオープンすると、あなたはオ
ープンしたファイルハンドルに書き込みができ、子プロセスはそれを自
分のSTDINに見いだします。マイナスからのパイプをオープンした場
合には、子プロセスがそのSTDOUTに書き出したものがオープンしたファ
イルハンドルから読みだしすることができるのです。
use English;
my $sleep_count = 0;
do {
$pid = open(KID_TO_WRITE, "|-");
unless (defined $pid) {
warn "cannot fork: $!";
die "bailing out" if $sleep_count++ > 6;
sleep 10;
}
} until defined $pid;
if ($pid) { # parent
print KID_TO_WRITE @some_data;
close(KID_TO_WRITE) || warn "kid exited $?";
} else { # child
($EUID, $EGID) = ($UID, $GID); # suid プログラムのみ
open (FILE, "> /safe/file")
|| die "can't open /safe/file: $!";
while (<STDIN>) {
print FILE; # 子プロセスの STDIN は親プロセスの KID
}
exit; # これを忘れてはいけません
}
このやり方を行うもう一つの一般的な例は、シェルのインターフェース 抜きで何かを実行する必要があるときでしょう。system()を使うとそれ は直接的なものですが、パイプのオープンやbackticksを安全に使うこ とができません。これはシェルがあなたの引数を触るのを止める方法が ないからです。代わりに、exec()を直接呼び出す低レベルな制御を使い ます。
以下の例は、読み込み用の安全なbacktickやパイプオープンのものです:
# 前述したようにエラー処理を付加する
$pid = open(KID_TO_READ, "-|");
if ($pid) { # 親プロセス
while (<KID_TO_READ>) {
# do something interesting
}
close(KID_TO_READ) || warn "kid exited $?";
} else { # 子プロセス
($EUID, $EGID) = ($UID, $GID); # suid のみ
exec($program, @options, @args)
|| die "can't exec program: $!";
# NOTREACHED
}
そして以下の例は、書き込み用の安全なbacktickやパイプオープンのものです:
# 前述したようにエラー処理を付加する
$pid = open(KID_TO_WRITE, "|-");
$SIG{ALRM} = sub { die "whoops, $program pipe broke" };
if ($pid) { # 親プロセス
for (@data) {
print KID_TO_WRITE;
}
close(KID_TO_WRITE) || warn "kid exited $?";
} else { # 子プロセス
($EUID, $EGID) = ($UID, $GID);
exec($program, @options, @args)
|| die "can't exec program: $!";
# NOTREACHED
}
これらの操作は UNIXのforkでいっぱいで、そのforkが他のシステムで は適切に実装されていない可能性があるのだということに注意してくだ さい。それに加えて、これらのやり方は本当のマルチスレッドではあり ません。スレッドについてより学びたいのであれば、SEE ALSOセクショ ンで言及されているF<modules>ファイルを参照してください。
他のプロセスとの双方向通信
これは、方向の定まっていない通信 (undirectional communication)に 対してうまく働きます。双方向通信 (bidirectional communication)は? あなたがやりたいだろうとまず考えることは、実際にはうまくいきません:
open(PROG_FOR_READING_AND_WRITING, "| some program |")
この状態で -wフラグを使うのを忘れてしまうと、以下のような診断 メッセージを得ることになるでしょう。
Can't do bidirectional pipe at -e line 1.
本当にこういったことをしたいのなら、標準のopen2()というライブラ
リ関数を使うことで、パイプの両方の端点を得ることができます。三方
向(tridirectional)の入出力のためのopen3()もあるので、子プロセス
のSTDERRを捕捉することもできるのですが、そのためには 不格好な
select()ループが必要となり、Perlの通常の入力操作を行うことができ
ません。
open2()のソースを見てみれば、それが全ての接続を生成するために
UNIXでのpipe()とexec()のような低水準のプリミティブを使っているこ
とに気がつくでしょう。これはsocketpair()を使うより効率が格段に良
いのですが、移植性という面では見劣りします。open2()とopen3()は
UNIXシステムやその他のPOSIXに従ったシステムを除いてはおそらく動
作しないでしょう。
以下は open2()を使った例です:
use FileHandle;
use IPC::Open2;
$pid = open2(*Reader, *Writer, "cat -u -n" );
Writer->autoflush(); # default here, actually
print Writer "stuff¥n";
$got = <Reader>;
これに関る問題は、UNIXのバッファリングが実際にはある時点に至るま で留まるということにあります。ファイルハンドルC<Writer>を自動フ ラッシュにしたとしても、もう一方の端点にあるプロセスは送られたデ ータをtimley mannerに従って受け取ることになるでしょう。一般的に 云って、全てのことに関して即座に反応するように強制することはでき ません。上記の例では、バッファリングをしないようにするために-u フラグを cat に与えることができたのでそれができました。パイプ 越しに使われることを想定して設計された UNIXコマンドは非常に少数 なので、この例のようなことは、dboule-enedパイプのもう一方の端点 にあるプログラムを自分自身で書かない限りはほとんどできないのです。
この解決策は非標準の Comm.plライブラリです。これはあなたのプ ログラムをより信頼性のあるものとするためにpseudo-ttysを使います:
require 'Comm.pl';
$ph = open_proc('cat -n');
for (1..10) {
print $ph "a line¥n";
print "got back ", scalar <$ph>;
}
このやり方では、あなたが使おうとしているプログラムのソースコード をいじくりまわすような必要はありません。Commライブラリには他 にもexpect()やinteract()といった関数もあります。SEE ALSOセクショ ンにある説明の最寄りのCPANで、このライブラリ(とその後継者と期待 している IPC::Chat)を見つけてください。
CPANにあるより新しいモジュールExpect.pmはこの問題に対処するものです。 このモジュールは他にIO:Pty、IO::Sttyという二つのCPANモジュールを 必要とします。このモジュールは、ターミナルデバイスドライバと応答するような プログラムと対話するために、擬似端末(pseudo-terminal)を セットアップします。もしあなたの使っているシステムが こういったものをサポートしているのであれば、そちらを使った方が 良いでしょう。
自分で双方向通信する
もし望むのなら、低レベルなシステムコールpipe()やfork()を 手作業で行うために使うことができます。以下の例は単に説明の ためのものですが、STDINやSTDOOUTに対する適切なハンドルを 再オープンすることができ、さらに別のプロセスを呼び出すことが できます。
#!/usr/bin/perl -w
# pipe1 - sockepairが使えない環境での、二つのパイプを
# 使った双方向通信
use IO::Handle; # autoflush のために何千行も :-(
pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
CHILD_WTR->autoflush(1);
PARENT_WTR->autoflush(1);
if ($pid = fork) {
close PARENT_RDR; close PARENT_WTR;
print CHILD_WTR "Parent Pid $$ is sending this¥n";
chomp($line = <CHILD_RDR>);
print "Parent Pid $$ just read this: `$line'¥n";
close CHILD_RDR; close CHILD_WTR;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close CHILD_RDR; close CHILD_WTR;
chomp($line = <PARENT_RDR>);
print "Child Pid $$ just read this: `$line'¥n";
print PARENT_WTR "Child Pid $$ is sending this¥n";
close PARENT_RDR; close PARENT_WTR;
exit;
}
しかし実際に二つのpipeの呼び出しを行う必要はありません。 あなたの使っているシステムがsocketpair()システムコールを サポートしていれば、それがあなたの代わりに作業を行ってくれます。
#!/usr/bin/perl -w
# pipe2 - socketpairを使った双方向通信
# "the best ones always go both ways"
use Socket;
use IO::Handle; # autoflushのために何千行も :-(
# *_LOCALがPOSIX 1003.1gのフォームで定数とされているにも
# 関らず、AF_UNIXを使うので、多くのマシンではまだこれを
# 持っていないでしょう
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
or die "socketpair: $!";
CHILD->autoflush(1);
PARENT->autoflush(1);
if ($pid = fork) {
close PARENT;
print CHILD "Parent Pid $$ is sending this¥n";
chomp($line = <CHILD>);
print "Parent Pid $$ just read this: `$line'¥n";
close CHILD;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close CHILD;
chomp($line = <PARENT>);
print "Child Pid $$ just read this: `$line'¥n";
print PARENT "Child Pid $$ is sending this¥n";
close PARENT;
exit;
}
ソケット:クライアント/サーバー 通信
UNIXから派生したオペレーティングシステムに限定されることはない (例えば PCではWinSockが(幾つかのVMSライブラリのように)ソケットサ ポートを提供しています)にも関らず、あなたが使っているシステムで はソケットが使えないかもしれません。その場合、このセクションに書 かれていることはあなたの役には立たないでしょう。ソケットを使えば、 仮想回路(virtual circuits、つまりTCPストリーム)やデータグラム(UDP パケット)の両方が可能になります。使っているシステムに、より一層 依存することになるかもしれません。
ソケットを扱うためのPerlの関数呼び出しは対応するCでのシステムコ ールと同じ名前を持っています。しかし、引数に関しては二つの理由に よって異なるものとなっています:第一に、Perlのファイルハンドルは Cのファイルディスクリプターとは異なる働きをするものである。第二 に、Perlはすでに文字列の長さを知っているので、その情報を渡す必要 がない、というものです。
Perlにおける古いソケットプログラムに関連する大きな問題とは、一部
の定数の値として(著しく移植性を損なってしまう)ハードコードされた
ものが使われていたということです。$AF_INET = 2のように陽に何 かを設定しているプログラムを見た事があれば、あなたはそれが大きな
トラブルになるということを知っているでしょう: より優れたやり方は
Socketモジュールを使うというものです。これは、あなたが必要と
するであろう様々な定数や関数に対するより信頼の置けるアクセスを提 供します。
NNTPやSMTPのように既に存在しているプロトコルのためにサーバー/ク ライアントを書くのでなければ、あなたの作るサーバーがどのようにし てクライアントが通話を終えたときを知ったり、その反対のことを知る のかということを考えておくべきでしょう。ほとんどのプロトコルは一 行のメッセージと返事(片方のプロセスは、“¥n”を受け取ったときに もう一つのプロセスでの処理が終了したことを知ります)か、空行に置 かれたピリオドで終端される(``¥n.¥n''がメッセージ/返事を終端する)複 数行メッセージと返事に基づいています。
インターネットの行終端子
インターネットでの行終端子は``¥015¥012''です。UNIXで使われる ASCIIのバリエーションでは、通常は“¥r¥n”のように記述しますが、 他のシステムでは、“¥r¥n”は``¥015¥015¥012''だったり、``¥012¥012¥015''だったり あるいはまったく違うものであったりします。“¥015¥012”は標準的な 書き方(あなたが書いたままのものになります)ですが、入力中にある 独立した“¥012”を受け付けることも推奨されています(が、あなたが要求する ときにはそれを穏やかなものにしましょう)。このマニュアルページにある プログラムについて、常に最善のものを使ってはいませんが、あなたが Macを使っているのでなければ気にすることはないでしょう。
自分の使っているシステムの外側にあるもマシンにまでクライアント- サーバーの通信を広げたい場合にはInternet-domain ソケットを使いま す。
以下のプログラムは、Internet-domain ソケットを使ったTCPクライアントの 例です:
#!/usr/bin/perl -w
use strict;
use Socket;
my ($remote,$port, $iaddr, $paddr, $proto, $line);
$remote = shift || 'localhost';
$port = shift || 2345; # random port
if ($port =‾ /¥D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr = inet_aton($remote) || die "no host: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
close (SOCK) || die "close: $!";
exit;
そして以下に挙げるのが上記のクライアントと対応するサーバーです。 ここではアドレスをINADDR_ANYとしているので、カーネルはmultihomed hosts上の適切なインターフェースを選択することができます。(ファイ ヤーウォールやゲイトウェイの外側のように)特定のインターフェース を使いたいのであれば、この部分を、自分の使いたい本当のアドレスで 埋めるようにすべきです。
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
$EOL = "¥015¥012";
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "¥n" }
my $port = shift || 2345;
my $proto = getprotobyname('tcp');
$port = $1 if $port =‾ /(¥d+)/; # untaint port number
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "server started on port $port";
my $paddr;
$SIG{CHLD} = ¥&REAPER;
for ( ; $paddr = accept(Client,Server); close Client) {
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "connection from $name [",
inet_ntoa($iaddr), "]
at port $port";
print Client "Hello there, $name, it's now ",
scalar localtime, $EOL;
}
以下の例はマルチスレッドバージョンです。これはほとんどの典型的な サーバーがそうであるようにマルチスレッドになっていて、クライアン トのリクエストを処理するためにスレイブサーバーをspawn(fork)しま す。このため、マスターサーバーは新しいクライアントに対してサービ スするために即座に復帰できます。
#!/usr/bin/perl -Tw
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
$EOL = "¥015¥012";
sub spawn; # 先行宣言
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "¥n" }
my $port = shift || 2345;
my $proto = getprotobyname('tcp');
$port = $1 if $port =‾ /(¥d+)/; # 汚染されていないポート番号
socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "server started on port $port";
my $waitedpid = 0;
my $paddr;
sub REAPER {
$waitedpid = wait;
$SIG{CHLD} = ¥&REAPER; # loathe sysV
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = ¥&REAPER;
for ( $waitedpid = 0;
($paddr = accept(Client,Server)) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid and not $paddr;
my($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "connection from $name [",
inet_ntoa($iaddr), "]
at port $port";
spawn sub {
print "Hello there, $name, it's now ", scalar localtime, $EOL;
exec '/usr/games/fortune' # XXX: `wrong' line terminators
or confess "can't exec fortune: $!";
};
}
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "begat $pid";
return; # I'm the parent
}
# else 自分は子プロセス -- spawnを実行
open(STDIN, "<&Client") || die "can't dup client to stdin";
open(STDOUT, ">&Client") || die "can't dup client to stdout";
## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
exit &$coderef();
}
このサーバーはリクエストがくる度にfork()を使って子バージョンの複 製を行うので、問題を取り除きます。このやり方は、あなたが常に望ん ではいないかもしれませんが、一度に多くのリクエストを処理すること ができます。fork()を使わなかったとしても、listen()は多くの一時停 止したコネクション(pending connections)を扱えます。サーバーをfork するので、死んだ子供(UNIX世界ではゾンビと呼ばれるもの)の後始末に 関して注意深くする必要があります。なぜなら、そうしなければプロセ ステーブルがすぐに埋めつくされることになるからです。
setuidやsetgidをされていない状態で実行されているとしても、汚染検 査(perlsecを参照)をするために-Tフラグを使うことをお勧めし ます。これは、サーバーやその他の他の誰かのために実行される(CGIス クリプトのような)プログラムに対しては常に良い考えになります。な ぜならそうすることによって、外部の人間があなたのシステムに入って くることができる可能性を減らすからです。
もう一つのTCPクライアントを見てみましょう。これは複数の異なるマ シン上のTCPの“time”サービスに接続してクライアントが走っている システムと時計がどれくらい違っているのを出力します:
#!/usr/bin/perl -w
use strict;
use Socket;
my $SECS_of_70_YEARS = 2208988800;
sub ctime { scalar localtime(shift) }
my $iaddr = gethostbyname('localhost');
my $proto = getprotobyname('tcp');
my $port = getservbyname('time', 'tcp');
my $paddr = sockaddr_in(0, $iaddr);
my($host);
$| = 1;
printf "%-24s %8s %s¥n", "localhost", 0, ctime(time());
foreach $host (@ARGV) {
printf "%-24s ", $host;
my $hisiaddr = inet_aton($host) || die "unknown host";
my $hispaddr = sockaddr_in($port, $hisiaddr);
socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCKET, $hispaddr) || die "bind: $!";
my $rtime = ' ';
read(SOCKET, $rtime, 4);
close(SOCKET);
my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
printf "%8d %s¥n", $histime - time, ctime($histime);
}
UNIXドメインのTCPクライアントとサーバー
Internet-domain のサーバーとクライアントは良いものですが、ローカ ルコミュニケーションに関してはどうでしょうか? 同じようにセットア ップすることができますが、同じ様に(通信を)行うことはできません。 UNIXドメインソケットはカレントホストにローカルで、しばしばパイプ を実装するために内部的に使われています。Internet ドメイン ソケッ トとは異なり、UNIXドメインソケットは、ls(1)を使ってファイルシス テムの中で見つけることができます。
% ls -l /dev/log
srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
これを、Perlのファイルテスト -S を使って行えます:
unless ( -S '/dev/log' ) {
die "something's wicked with the print system";
}
UNIXドメインクライアントの例です:
#!/usr/bin/perl -w
use Socket;
use strict;
my ($rendezvous, $line);
$rendezvous = shift || '/tmp/catsock';
socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while (defined($line = <SOCK>)) {
print $line;
}
exit;
そして対応するサーバーです。
ここで、あなたはやっかいなネットワーク終端子について思い煩う 必要はありません。なぜなら、UNIXのドメインソケットは ローカルホストにおいて完全に満たされるものであって、そのため、 全てはうまくいくのです。
#!/usr/bin/perl -Tw
use strict;
use Socket;
use Carp;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
sub logmsg { print "$0 $$: @_ at ", scalar localtime, "¥n" }
my $NAME = '/tmp/catsock';
my $uaddr = sockaddr_un($NAME);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
unlink($NAME);
bind (Server, $uaddr) || die "bind: $!";
listen(Server,SOMAXCONN) || die "listen: $!";
logmsg "server started on $NAME";
my $waitedpid;
sub REAPER {
$waitedpid = wait;
$SIG{CHLD} = ¥&REAPER; # loathe sysV
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = ¥&REAPER;
for ( $waitedpid = 0;
accept(Client,Server) || $waitedpid;
$waitedpid = 0, close Client)
{
next if $waitedpid;
logmsg "connection on $NAME";
spawn sub {
print "Hello there, it's now ", scalar localtime, "¥n";
exec '/usr/games/fortune' or die "can't exec fortune: $!";
};
}
見てわかるように、Internet domain TCP サーバーとほとんど同じです。
実際には、まったく変っていない幾つかの重複した関数spawn(),
logmsg(), ctime(),
REAPER()を取り除いてあります。
ではなぜ、単純な名前付きパイプではなくUNIXドメインソケットを使い たがるのでしょうか? その理由は、名前付きパイプがあなたにセッショ ンを与えないからです。あなたはあるプロセスから来たデータと、それ とは別のプロセスからきたデータとを区別することができません。ソケ ットプログラミングを行うことで、クライアント毎に別々のセッション を持てるようになります: これがaccept()が二つの引数を取る理由です。
例えば、CGIインターフェースを通してのみWorld Wide Webからアクセ スされる、長時間実行されているデータベースサーバーデーモンを持っ ているとしましょう。この場合、あなたの好きなようにチェックやログ の記録を実行するような小さく、単純なCGIプログラムを持って、UNIX ドメインクライアントとして振る舞うプライベートなサーバーに接続さ せるといったことができるでしょう。
ソケットプログラミングに対する高水準インターフェースのために、IO::Socket モジュールはオブジェクト指向アプローチを提供します。IO::Socketモ ジュールはリリース 5.004の標準 Perl 配布キットの一部として含まれ ています。あなたが以前のバージョンのPerlを使っているのであれば、 CPANからIO::Socketを入手します。そこでは、以下に挙げるようなシス テムに対する簡単なインターフェースを提供するシステムも見つけるこ とができるでしょう: DNS, FTP, Ident (RFC 931), NIS, NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, Time など。
以下の例は“localhost”というホスト名の13番ポートにある“dyatime” サービスに対するTCPコネクションを作成するクライアントで、そのサ ーバーが提供するデータをすべて出力します。
#!/usr/bin/perl -w
use IO::Socket;
$remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => "localhost",
PeerPort => "daytime(13)",
)
or die "cannot connect to daytime port at localhost";
while ( <$remote> ) { print }
このプログラムを実行すると、以下のような返事が返ってくるでしょう:
Wed May 14 08:40:46 MDT 1997
newコンストラクターに対するパラメーターの意味を説明します:
これは使用するプロトコルです。この例では、私たちはストリーム指向 のコネクション、つまり、通常の古いファイル(plain old file)のよう に振る舞うものを使いたいので、ソケットはTCPソケットに接続された ものを扱います。ソケットにはこれ以外のタイプもあることに注意して ください。たとえば、UPDプロトコルは(メッセージ送信に使われている) データグラムソケットを作成するために使うことができます。
これはサーバーが実行されているリモートホストの、インターネットア
ドレスもしくは名前です。これを "www.perl.com" のような長い名 前で指定することも "204.148.40.9"のようなアドレスで指定するこ ともできます。先の例で使った "localhost"は、常に自分が使用し
ている現在のマシンを意味する特別なホスト名です。ローカルホストに
対するインターネットアドレスは"127.1"で、こちらを使うこともで きます。
これは接続したいサービスの名称、もしくはポート番号です。私たちは 先の例で、きちんと設定されたシステムサービスの使えるシステムでな らC<``daytime''>を使うこともできました [FOOTNOTE: UNIXでは /etc/services にシステムサービスファイルがあります]。しかし、実際には括弧でく くって(13)というポート番号の指定を行っていました。単に番号を使っ ても同様に動作するのですが、定数は注意深いプログラマーを神経質に させてしまいます。
コンストラクター newの戻り値が、whileループの中のファイル
ハンドルとしてどのように使われているかということに気がつきました か?
これは間接ファイルハンドル(indirect filehandle)と呼ばれるも
ので、ファイルハンドルを保持しているスカラー変数です。これは、通
常のファイルハンドルと同様のやり方で使うことができます。例えば、
以下のようにすれば一行読み込みができます:
$line = <$handle>;
残りの行全ての読み込みは以下のようにします:
@lines = <$handle>;
データを一行送るには以下のようにします:
print $handle "some data¥n";
以下の例は、ドキュメントをそこから取るリモートホストと、そのホス トから取得するドキュメントのリストを引数に取る単純なクライアント です。これは先の例よりも興味深いものです。なぜなら、この例におい てはサーバーの反応をフェッチする前に最初に何かをサーバーに送信す るからです。
#!/usr/bin/perl -w
use IO::Socket;
unless (@ARGV > 1) { die "usage: $0 host document ..." }
$EOL = "¥015¥012";
$BLANK = $EOL x 2;
$host = shift(@ARGV);
foreach $document ( @ARGV ) {
$remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => $host,
PeerPort => "http(80)",
);
unless ($remote) { die "cannot connect to http daemon on $host" }
$remote->autoflush(1);
print $remote "GET $document HTTP/1.0" . $BLANK;
while ( <$remote> ) { print }
close $remote;
}
ここでは、“http”サービスを提供するwebサーバーがその標準ポート である
80番ポートを使っていると仮定しています。あなたの使ってい
るwebサーバーが異なるポート(例えば1080とか8080とか)を使用してい
るのであれば、名前付きパラメータペアにしてPeerPort => 8080
のような形式で指定すべきでしょう。autoflush メソッドがソケッ トに対して使われます。そうしなければシステムは私たちが送信した出
力をバッファリングしてしまうでしょう(あなたがMacを使っているので
あれば、ネットワーク越しにデータを送信するプログラム中にあるすべ ての"¥n"をC<``¥015¥012''>に変更する必要もあります)。
サーバーへの接続は、このプロセスの最初の一部分でしかありません: 一度接続されてしまえば、サーバーの言語を使うべきなのです。ネット ワーク上の各サーバーは、入力として期待しているそれぞれのlittle command languageを持っています。HTTP構文において最初にサーバーに 送信するのは ``GET'' です。この場合、単純に指定されたドキュメント のそれぞれをリクエストします。そう、私たちは実際には、たとえ同じ ホストであったとしてもドキュメント毎に新しいコネクションを作成し ています。これがHTTPを使うときに常にそうしなければならない方法な のです。最近のwebブラウザーではコネクションを開いたままちょっと の間リモートサーバーを離れるリクエストをすることができますが、サ ーバーはそのようなリクエストを処理しなければならないというわけで はありません。
以下に挙げるのは、私たちがwebgetと呼ぶであろうプログラムを実 行した例です。
% webget www.perl.com /guanaco.html
HTTP/1.1 404 File Not Found
Date: Thu, 08 May 1997 18:02:32 GMT
Server: Apache/1.2b6
Connection: close
Content-type: text/html
<HEAD><TITLE>404 File Not Found</TITLE></HEAD>
<BODY><H1>File Not Found</H1>
The requested URL /guanaco.html was not found on this server.<P>
</BODY>
これは特定のドキュメントを見つけられないというものですからあまり 面白いものでもありません。でも、長いレスポンスをここに載せるわけ にもいかないでしょう。
このプログラムの全機能バージョン(fully-featured version)は、CPAN にあるLWPモジュール中のlwp-requestというプログラムを見るとよ いでしょう。
IO::Socketを使った対話的クライアント
一つのコマンドを送信し、一つの返答を得るというのであれば具合が良 いのですが、完全に対話的な何かを設定し、telnetのように動作す るものはどうでしょうか?ここでできるのは、ある一行をタイプして答 を得て、別の行をタイプしてそれに対する答を得て、etc…というやり 方です。
このクライアントは既に出てきた二つのものよりも複雑ですが、あなた が強力なfork呼び出しをサポートしているシステムを使っているの
であれば、解決策はラフなものではありません。通信したいなんらかの
サービスに対してコネクションを作ってしまえば、プロセスの複製を作 るためにforkを呼び出します。それによる二つのプロセスはそれぞ
れ、非常に単純なジョブを行います:親プロセスはソケットから入力さ
れたすべてを標準出力にコピーし、子プロセスは標準入力をソケットへ
と同じようにコピーします。ただ一つのプロセスを使ったときに同じこ
とをするのは非常に難しいでしょう。なぜなら、二つのことを行う
一つのプロセスのためのプログラムよりも一つのことを行う二つのプロ
セスのためのプログラムのほうが簡単だからです(この keep-it-simple 法則は
UNIX文化の要石で、良いソフトウェアエンジニアが使うように、
(UNIXが)他のシステムよりも広く使われていることの理由でしょう)。
プログラムの例です:
#!/usr/bin/perl -w
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);
unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;
# 指定したホスト、ポートに対するコネクションを生成する
$handle = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
PeerPort => $port)
or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # これで出力が正しく行われる
print STDERR "[Connected to $host:$port]¥n";
# プログラムを二つのプロセスに分割する
die "can't fork: $!" unless defined($kidpid = fork());
# if{}ブロックは親プロセスでのみ実行される
if ($kidpid) {
# ソケットから標準出力へコピーする
while (defined ($line = <$handle>)) {
print STDOUT $line;
}
kill("TERM", $kidpid); # 子プロセスに SIGTERM を送る
}
# else{} ブロックは子プロセスでのみ実行される
else {
# 標準入力からソケットへコピーする
while (defined ($line = <STDIN>)) {
print $handle $line;
}
}
親プロセスのifブロックにある kill関数は、リモートサーバー
がコネクションを終了してクローズしてすぐに子プロセス(elseブロ ックを実行しています)にシグナルを送るためのものです。
リモートサーバーが一度に一バイト送っていて、そして、あなたが改行
を待つことなしに即座にデータを必要とする(そうそうないことでしょ
うが)のなら、whileループを以下のようなものに置き換えたくなる でしょう:
my $byte;
while (sysread($handle, $byte, 1) == 1) {
print STDOUT $byte;
}
読み出しのために一バイト毎にシステムコールを行うのは実に非効率的 ですが、説明するのに簡単でとりあえずは動くのです:
IO::Socket を使ったTCPサーバー
常にそうであるように、サーバーのセッティングはクライアントを実行する
よりもほんのちょっと手間がかかります。
ここで使うのは、サーバーが特定のポートで接続を待つだけ
という特殊な種類のソケットを作成するというモデルです。これは、
IO::Socket::INET->new()というメソッドをはっきりと異なる引
数を付けて呼び出してからクライアントを実行することで行います。
これは使用するプロトコルです。クライアントと同様、ここでは
"tcp" を指定します。
LocalPort 引数でローカルポートを指定します。これはサーバーに
したいサービス名かポート番号のいずれかです(UNIXでは、1024未満の
ポートはスーパーユーザー限定です)。私たちのサンプルでは 9000番ポ
ートを使いますが、あなたの使っているシステムで重複しなければ好き
な番号を使うことができます。もし既に使われているポートを使おうと すれば、``Address
already in use''のようなメッセージを得ることとな るでしょう。UNIXでは、netstat -aコマンドを使ってサービスが現 在使っているサーバーを見ることができます。
Listen パラメーターは、クライアントを待たせておいて受け付ける ことのできるコネクションの最大数を設定します。電話の呼び出しを考 えてみてください。低水準ソケットモジュールは SOMAXCONN というそ のシステムの最大値を表す特殊なシンボルを持っています。
Reuseパラメーターは、システムがバッファーをクリアするための時 間を掛けずに私たちのサーバーを手作業で再起動するのに必要です。
上で述べたパラメーターを持った汎用のサーバーソケットが生成されれ
ば、そのサーバーは接続される新たなクライアントを待ちます。accept
メソッドにあるサーバーブロックはリモートクライアントに双方向接続
されます(バッファリングを抑制するためにハンドルに対してautolush
することを忘れないように)。
ユーザーに親切にするために、私たちのサーバーはコマンドの入力のプ
ロンプトを表示します。ほとんどのサーバーはこうしたことをしていま
せん。プロンプトには改行がないので、上の例にあったような対話的な
クライアントの類ではsysreadを使う必要があるでしょう。
このサーバーは五種類のコマンドのいずれか一つを取り、クライアント に対して(コマンドに応じた)出力を行います。多くのネットワークサー バーとは異なり、このサーバープログラムは一度に一つのクライアント しか扱えないということに注意してください。マルチスレッド化された サーバーはらくだ本の第六章でカバーされています。
以下プログラムです。
#!/usr/bin/perl -w use IO::Socket; use Net::hostent; # gethostbyaddr のOOバージョンのため
$PORT = 9000; # 使われていないものを採用する
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server; print "[Server $0 accepting clients]¥n";
while ($client = $server->accept()) {
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.¥n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]¥n", $hostinfo->name || $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /¥S/; # 空行
if (/quit|exit/i) { last; }
elsif (/date|time/i) { printf $client "%s¥n", scalar localtime; }
elsif (/who/i ) { print $client `who 2>&1`; }
elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
else {
print $client "Commands: quit date who cookie motd¥n";
}
} continue {
print $client "Command? ";
}
close $client;
}
クライアント・サーバーをセットアップするもう一つの種類はコネクシ ョンではなくメッセージを使うものです。UDP通信はオーバーヘッドが 低いものの、メッセージがすべて到着するという保証がなく到着の順序 もきちんと保たれていることも保証されてないために信頼性もまた劣る ものになっています。それでも、UDPには一度に宛て先ホストの塊全体 (通常はローカルサブネット)に対して“ブロードキャスト”、“マルチ キャスト”ができるということを含め、TCPに対する幾つかのアドバン テージがあります。信頼性に関して過度に関心を持ち、作成するメッセ ージシステムに検査機構を組み込もうというのであれば、むしろTCPを 使うようにした方がよいでしょう。
以下に挙げた UDPプログラムは先に挙げたインターネト TCP クライア ントの例と似ていますが、一度に一つのホストをチェックするのではな く、マルチキャストをシミュレートし、かつ、select()を入出力のタイ ムアウト待ちのために使うことにより非同期的(asynchronously)にたく さんのチェックを行います。TCPでこれと同じことを行うには、ホスト 毎に異なるソケットハンドルを使わなければならないでしょう。
#!/usr/bin/perl -w
use strict;
use Socket;
use Sys::Hostname;
my ( $count, $hisiaddr, $hispaddr, $histime,
$host, $iaddr, $paddr, $port, $proto,
$rin, $rout, $rtime, $SECS_of_70_YEARS);
$SECS_of_70_YEARS = 2208988800;
$iaddr = gethostbyname(hostname());
$proto = getprotobyname('udp');
$port = getservbyname('time', 'udp');
$paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
bind(SOCKET, $paddr) || die "bind: $!";
$| = 1;
printf "%-12s %8s %s¥n", "localhost", 0, scalar localtime time;
$count = 0;
for $host (@ARGV) {
$count++;
$hisiaddr = inet_aton($host) || die "unknown host";
$hispaddr = sockaddr_in($port, $hisiaddr);
defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
}
$rin = '';
vec($rin, fileno(SOCKET), 1) = 1;
# 十秒後にタイムアウト
while ($count && select($rout = $rin, undef, undef, 10.0)) {
$rtime = '';
($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
($port, $hisiaddr) = sockaddr_in($hispaddr);
$host = gethostbyaddr($hisiaddr, AF_INET);
$histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
printf "%-12s ", $host;
printf "%8d %s¥n", $histime - time, scalar localtime($histime);
$count--;
}
System V IPC はソケットとしてはそれ程広く使われてはいませんが、 幾つかの興味深い使用法があります。ただし、System VのIPCや Berkleyのmmap()を(異なる幾つかのプロセスの間で変数を共有するため の)共有メモリを持つ目的のために効率良く使うことはできません。な ぜならPerlが、あなたが望まないときに文字列の再割り付けをやってし まう可能性があるからです。
共有メモリの使い方を例示する小さな例です。
use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO);
$size = 2000;
$key = shmget($IPC_PRIVATE, $size , 0777 );
$key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
print "shm key $key¥n";
$message = "Message #1";
shmwrite($key, $message, 0, 60) || die "$!";
print "wrote: '$message'¥n";
shmread($key, $buff, 0, 60) || die "$!";
print "read : '$buff'¥n";
# the buffer of shmread is zero-character end-padded.
substr($buff, index($buff, "¥0")) = '';
print "un" unless $buff eq $message;
print "swell¥n";
print "deleting shm $key¥n";
shmctl($key, IPC_RMID, 0) || die "$!";
以下はセマフォの例です:
$key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
print "shm key $key¥n";
二つ以上のプロセスで動作するように、このコードを分割されたファイ ルに置きます。そのファイルをF<take>と呼びます:
# セマフォを生成する
$IPC_KEY = 1234;
$key = semget($IPC_KEY, 0 , 0 );
die if !defined($key);
$semnum = 0;
$semflag = 0;
# セマフォを“取る”
# セマフォが0になるのを待つ
$semop = 0;
$opstring1 = pack("sss", $semnum, $semop, $semflag);
# セマフォカウントをインクリメントする
$semop = 1;
$opstring2 = pack("sss", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
semop($key,$opstring) || die "$!";
このコードを、二つ以上のプロセスで実行できるように別のファイルに 置きます。このファイルをF<give>: と呼びます。
# セマフォを“与える”
# これをオリジナルのプロセスで実行すれば、
# 二番目のプロセスが継続するのが確認できるでしょう
$IPC_KEY = 1234;
$key = semget($IPC_KEY, 0, 0);
die if !defined($key);
$semnum = 0;
$semflag = 0;
# セマフォのカウントをデクリメントする
$semop = -1;
$opstring = pack("sss", $semnum, $semop, $semflag);
semop($key,$opstring) || die "$!";
ここで例示したSystem VのIPCコードははるかな昔に書かれたもので、 へぼなものに見えます。より現代的なものについては、 Perl 5.005に含まれている IPC::SysVモジュールを参照してください。
これらのルーチンのほとんどは物静かですが、何かに失敗した場合には
あなたのプログラムを終了させてしまったり捕捉されない例外を引き起
こしたりする代わりにundefを返します(実際には、新しいSocket
変換関数の幾つかは不正な引数に対してcroak()します)。したがって要
点は、これらの関数の戻り値を確認すべきであるということです。ソケ
ットプログラムは常に最良の成功(optimal success)のためにこのやり
方で始め、そしてサーバーに対して pound-bang line (#!の行のこと)に
汚染検査フラグ -Tを追加することを忘れないようにしてください。
#!/usr/bin/perl -Tw
use strict;
use sigtrap;
use Socket;
これらのルーチンは全て、システム固有の移植性問題を作り出します。 他の場所で説明したように、Perlの振る舞いは使用しているCライブラ リに左右されます。System Vのおかしなシグナルのセマンティクスを仮 定することと、単純なTCPおよびUDPソケット操作に終始するようにする ことがおそらくは最も安全なもののでしょう。たとえば、あなたが自分 のプログラムに移植性を持たせるようにしたいのであれば、ローカルな UDPデータグラムのソケットを通してファイルディスクリプターを渡す ようなことをしようとしてはいけないということです。
シグナルのセクションで述べたように、
安全に再入可能なCライブラリを提供しているベンダーはごくわずかで
すから、注意深いプログラマーは既に存在している数値変数を設定する
こと以上のことはしないでしょう。あるいは、遅い(再起動する)システ
ムコールに縛られているのであれば、例外を引き起こしてlongjmp(3)し て外へ抜けるために
die()を使うでしょう。実際には、これらのことを
行っていてもコアダンプすることがあるかもしれません。シグナルを絶
対に逃れることのできない場所でないかぎり、そのシグナルを除去する
のがおそらく最善です。この危険な問題は将来の Perlで対処されるこ
とでしょう。
Tom Christiansen, with occasional vestiges of Larry Wall's original version and suggestions from the Perl Porters.
ネットワークに関する事柄はまだまだたくさんあります.ここにあるこ とはスタートでしかありません。
Richard Stevens による非常に重要な教科書 Unix Network Programming (アジソンウェスレイから出版されています)があります。ネットワーク に関するほとんどの本は、Cプログラマーを対象としたネットワーキン グを指向している点に注意してください。Perlへの変換は、読者の宿題 として残しておきます。
IO::Socket(3)マニュアルページにはオブジェクトライブラリの説明が あり、Socket(3)には低水準のソケットに対するインターフェースの説 明があります。perlfuncにある関数の他にも、至近にあるCPANサイ トでmodulesファイルをチェックしたほうが良いでしょう(perlmodlib を参照するか、CPANがどこにあるかの説明があるF<Perl FAQ>を見ると よいでしょう)。
modluesファイルの第五セクションは ``Networking, Device Control (modems), and Interprocess Communication'' に充てられていて、バンドルされなかった多くのネットワーク関連モジ ュール、チャット と Expect operations, CGI プログラミング, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet, スレッド、 そしてToolTalkを含んでいます。