by Hippo2000(2000/12/27)
DBI::ProxyServerの親の親、Net::Daemonなのです。
作者はJochen Wiedmannさんです。それにしても、この方は色々なものを作っています。
Jochen Wiedmannさんにはメールで了解をいただきました。
なお内容等が間違っていたら修正します。ご連絡ください。
なおLWPモジュールには以下のサブクラスがあります。
クラス名 説 明 Net::Daemon::Log ログ出力のためのユーティリティ関数 Net::Daemon::Test Net::Daemonサーバーをテストするためのサポート関数
Net::Daemon - 移植可能なデーモンのためのPerl拡張
# Net::Daemonのサブクラスの作成 require Net::Daemon; package MyDaemon; @MyDaemon::ISA = qw(Net::Daemon);
sub Run ($) {
# この関数が本当に動きます； これは新しく接続がおこなわれるたびに
# 呼び出されます
}
これはALPHA状態のソフトウェアです。 これはインターフェース(API)が最終確定されていないためだけに'Alpha'になっています。Alpha状態はコードの品質や安定性には当てはまりません。
Net::Daemon はとても簡単に移植可能なサーバー・アプリケーションを実装するための抽象クラスです。このモジュールはPerl5.005のために設計されていますが、fork()とPerl5.004で機能します。
Net::Daemon クラスはデーモンに必要なほとんどの一般的なタスクのためのメソッドを提供します：起動、ログ出力、クライアント認証、セキュリティのために自分の環境を制限すること、そして本当の機能をおこなうこと。あなたはあなたの目的に合わないメソッドだけを上書きするだけでよいのです。しかし典型的には継承すると仕事を減らしてくれるでしょう。
$server = Net::Daemon->new($attr, $options);
$connection = $server->Clone($socket);
２つのコンストラクタが利用できます：new メソッドは起動時と基本的にプログラム全体でのアンカーとして機能するオブジェクトが作られるときに呼ばれます。これはGetopt::Long (3) を通じてコマンド・ラインの解析もサポートします。
new の引数は属性のハッシュ・リファレンスである $attr （下記をご覧ください）とオプションの配列リファレンスである $options で、これは典型的にはコマンド・ライン引数（例えば \@ARGV ） で Getopt::Long::GetOptions に渡されます。
２番目のコンストラクタはClone です。これはクライアントが接続するたびに呼ばれます。これはメインのサーバー・オブジェクトを入力として受け取り、新しいオブジェクトを返します。この新しいオブジェクトは、最終的にクライアントと通信する本来の仕事をおこなうメソッドに渡されます。通信はClone の引数である、$socket ソケットで行われます。
設定できるオブジェクト属性と対応するコマンドラインの引数は以下の通りです：
GIDにはグループ名も数値も渡すことができます。
このインターバルの精度をあまり信用しないで下さい。これはいくつかの要素、特にLoop()メソッドの実行時間に依存しています。ループはselect()関数を使って実装されています。正確なインターバルが必要であれば、alarm()関数とシグナル・ハンドラを使ったほうがよいでしょう。（catchint オプションを見るのを忘れないで下さい！）
loop-timeout.と結び付けるには、loop-child オプションを使うことをお勧めします。
Perl 5.005を実行し、スレッドが利用できるようにコンパイルしてあれば、サーバーは各接続に対して新しいスレッドを作成します。そのスレッドはサーバーのRun()メソッドを実行し、終了します。このモードがデフォルトで、これは"--mode=threads"で強制することができます。
もしスレッドが使ええなくても、機能するfork()を持っているのであれば、そこでサーバーは同様に、各接続に対して新しいスレッドを作成します。このモードはスレッドがない場合には自動的に、もしくは"--mode=fork"オプションを使うと使われます。
最後にシングルーコネクション・モードがあります。サーバーが接続を受け取ると、それがRun()メソッドに入ります。他の接続はRun()メソッドから戻ってくるまで受け取られません。このオプションはMacintoshのようにスレッドもfork()持っていないときに有効です。デバッグ目的のために、このモードを"--mode=single"を強制することができます。
UIDにはグループ名も数値も渡すことができます。
これらの属性のほとんど(facility, mode, localaddr, localport, pidfile, version) がｍ起動のときにのみ意味があることに注意してください。もし後で設定すると、単に無視されます。ほとんどすべての属性は適切なデフォルトを持っています。典型的にはlocalportポートだけを使います。
my $optionsAvailable = Net::Daemon->Options();
print Net::Daemon->Version(), "\n";
Net::Daemon->Usage();
Options メソッドはありうるコマンド・ライン・オプションのハッシュ・リファレンスを返します。キーはオプション名、値は以下のキーを持ったハッシュ・リファレンスです：
Usage メソッドはすべての可能なオプションと戻りのリストを出力します。それはプログラム名とバージョンを出力するために Version メソッドを使います。
もし構成設定ファイル(config file)オプションがコマンドライン・オプションか"new"の引数でで指定されると、以下のメソッド
$server->ReadConfigFile($file, $options, $args)
が呼び出されます。デフォルトでは構成設定ファイルはオプションのハッシュ・リファレンスを返すPerlソースが入っていることが予定されています。これらのオプションは"new"引数を上書きし、$options ハッシュ・リファレンスで表されたように、コマンドライン・オプションによって上書きされます。
典型的な構成設定ファイルは以下のようになります、例としてDBI::ProxyServerを使います：
# 外部のモジュールをロードします：これは使わなければ必要ありません
# chroot() オプション.
#require DBD::mysql;
#require DBD::CSV;
{
# 'chroot' => '/var/dbiproxy',
'facility' => 'daemon',
'pidfile' => '/var/dbiproxy/dbiproxy.pid',
'user' => 'nobody',
'group' => 'nobody',
'localport' => '1003',
'mode' => 'fork'
# アクセス制御
'clients' => [
# ローカルは受け付ける
{
'mask' => '^192\.168\.1\.\d+$',
'accept' => 1
},
# myhost.company.comを受け付ける
{
'mask' => '^myhost\.company\.com$',
'accept' => 1
}
# その他は拒絶する
{
'mask' => '.*',
'accept' => 0
}
]
}
Net::Daemon パッケージはホスト・ベースのアクセス制御のスキームをサポートしています。デフォルトではすべての人にアクセスが開かれています。しかし 属性 $self->{'clients'} を作れば、典型的には構成設定ファイルになりますが、デフォルトでアクセス制御ができなくなります。すべての接続について、クライアント・リストが処理されます。clients属性はハッシュ・リファレンスのリストへの配列リファレンスです。ハッシュ・リファレンスのいずれにも以下のものを含めた、任意の属性を入れることができます。
$server->Log($level, $format, @args); $server->Debug($format, @args); $server->Error($format, @args); $server->Fatal($format, @args);
Log メソッドはSys::Syslog (3) または Win32::EventLog (3) へのインターフェースです。その引数はdebug、 notice または err のようなsyslogレベルである$level 、printfの形式でのフォーマット文字列、そして フォーマット文字列引数です。
Debug と Error メソッドはそれぞれ、debug と err レベルでのLogを呼び出すための短縮です。Fatal メソッドは Error に似ていますが、さらに与えられたメッセージを例外として投げます。
詳細については Net::Daemon::Log(3) をご覧ください。
$server->Bind();
# Bind()のう内側では以下の通り：
if ($connection->Accept()) {
$connection->Run();
} else {
$connection->Log('err', 'Connection refused');
}
サーバーが開始するときにBind メソッドがアプリケーションにより呼び出されます。典型的にはサーバー・オブジェクト $server が作られたすぐ後におこなうことができます。エラーの場合を除いて、Bind は通常何も返しません。
クライアントが接続すると、サーバーは、サーバーからconnection オブジェクト$connection を派生されるためにCloneを使います。あなたのクラスのAcceptメソッドを呼び出すためにconnectionオブジェクトを使う新しいスレッドもしくはプロセスが作成されます。このメソッドはホスト認証をするようになっており、FALSE（クライアントの拒絶）あるいはTRUE（クライアントの受入）のどちらかを返します。
もしクライアントが受け入れられると、実際の作業をおこなうRun メソッドが呼び出されます。Runが戻り、対応するスレッドまたはプロセスが終了すると、接続はクローズされます。
すべてのメソッドはエラーの場合にはPerlの例外を投げるようになっています。
すべてのメソッドはレキスカルなスコープのデータだけで動きます。例外はOpenLogメソッドでこれはスレッドが開始する前に呼び出されます。このため、スレッド間でハンドルを共有しないかぎり安全です。私はあなたのアプリケーション同じように振る舞うことを強く推奨します。
例として、簡単な計算機(calculator)サーバーを書きます。このサーバーに接続した後、１行毎に数式を入力来ることができます。サーバーはその数式を評価し、結果を出力します。（これは例です。実際にはこのようなセキュリティホールを実装することはありません。 :-)）
例のため、値として'hex'、'oct'、'dec'を取る、コマンドライン・オプション --base を追加します。サーバー出力はその基数を使います。
# -*- perl -*- # # 計算機サーバー（Calculator server） # require 5.004; use strict;
require Net::Daemon;
package Calculator;
use vars qw($VERSION @ISA); $VERSION = '0.01'; @ISA = qw(Net::Daemon); # Net::Daemonから継承するために
sub Version ($) { 'Calculator Example Server, 0.01'; }
# コマンドラインのオプション "--base"を追加します
sub Options ($) {
my($self) = @_;
my($options) = $self->SUPER::Options();
$options->{'base'} = { 'template' => 'base=s',
'description' => '--base '
. 'dec (default), hex or oct'
};
$options;
}
# コマンド行のオプションをコンストラクタで扱います
sub new ($$;$) {
my($class, $attr, $args) = @_;
my($self) = $class->SUPER::new($attr, $args);
if ($self->{'parent'}) {
# Called via Clone()
$self->{'base'} = $self->{'parent'}->{'base'};
} else {
# Initial call
if ($self->{'options'} && $self->{'options'}->{'base'}) {
$self->{'base'} = $self->{'options'}->{'base'}
}
}
if (!$self->{'base'}) {
$self->{'base'} = 'dec';
}
$self;
}
sub Run ($) {
my($self) = @_;
my($line, $sock);
$sock = $self->{'socket'};
while (1) {
if (!defined($line = $sock->getline())) {
if ($sock->error()) {
$self->Error("Client connection error %s",
$sock->error());
}
$sock->close();
return;
}
$line =~ s/\s+$//; # Remove CRLF
my($result) = eval $line;
my($rc);
if ($self->{'base'} eq 'hex') {
$rc = printf $sock ("%x\n", $result);
} elsif ($self->{'base'} eq 'oct') {
$rc = printf $sock ("%o\n", $result);
} else {
$rc = printf $sock ("%d\n", $result);
}
if (!$rc) {
$self->Error("Client connection error %s",
$sock->error());
$sock->close();
return;
}
}
}
package main;
my $server = Calculator->new({'pidfile' => 'none',
'localport' => 2000}, \@ARGV);
$server->Bind();
（原文のまま）
Net::Daemon is Copyright (C) 1998, Jochen Wiedmann
Am Eisteich 9
72555 Metzingen
Germany
Phone: +49 7123 14887
Email: joe@ispsoft.de
All rights reserved.
You may distribute this package under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file.
RPC::pServer(3), Netserver::Generic(3), Net::Daemon::Log(3), Net::Daemon::Test(3)
ご意見、ご質問はこちらの掲示板で受け付けています。
またメールは河馬屋(Nifty)にお願いします。