September 22, 2003
server_{init,exit}
依存関係が明確になったところで、
temp.pl
というメインスクリプトに
ごちゃごちゃとサーバ機能部を記述するのを辞めて、
RRDs::shellパッケージに追い出しました。
前回コードを整理してあったので、
ほぼそのままコードをコピペしてRRDs::shell::server_init()という関数に収めました。
終了シーケンスはRRDs::shell::server_exit()という関数に収めています。
1: --- temp.pl 2003/09/21 14:04:48 7.4
2: +++ temp.pl 2003/09/21 14:19:43 7.5
3: @@ -149,83 +149,7 @@
4: my $crontab = step2crontab($rrd->{step});
5: $rrd->log("$0 started with $crontab");
6: my $cron = DateTime::Event::Cron->new_from_cron($crontab);
7: - {
8: - POE::Session->create
9: - (
10: - inline_states =>
11: - {
12: - _start => sub {
13: - my $socket_rendezvous = '/tmp/rrd-temp-rendezvous';
14: - unlink $socket_rendezvous if -e $socket_rendezvous;
15: - eval {
16: - use Socket;
17: - use POE::Wheel::SocketFactory;
18: - };
19: - $_[HEAP]->{socket} = POE::Wheel::SocketFactory->new
20: - (
21: - SocketDomain => PF_UNIX,
22: - BindAddress => $socket_rendezvous,
23: - SuccessEvent => 'got_client',
24: - FailureEvent => 'got_error',
25: - );
26: - $_[KERNEL]->alias_set('socket');
27: - },
28: - _exit => sub {
29: - $_[KERNEL]->post(client => '_exit');
30: - delete $_[HEAP]->{socket};
31: - },
32: - got_client => sub {
33: - POE::Session->create
34: - (
35: - inline_states =>
36: - {
37: - _start => sub {
38: - eval {
39: - use POE::Wheel::ReadWrite;
40: - };
41: - $_[HEAP]->{client} = POE::Wheel::ReadWrite->new
42: - (
43: - Handle => $_[ARG0],
44: - InputEvent => 'got_client_input',
45: - ErrorEvent => 'got_client_error',
46: - );
47: - $_[KERNEL]->alias_set('client');
48: - $_[HEAP]->{client}->put("Welcome to RRDs::rrd::temp [$$].");
49: - },
50: - _exit => sub {
51: - delete $_[HEAP]->{client};
52: - },
53: - got_client_input => sub {
54: - $_[HEAP]->{client}->put("executing $_[ARG0]...");
55: - eval { my $cmd = $_[ARG0]; $rrd->$cmd(); };
56: - if ($@) {
57: - chomp $@;
58: - $_[HEAP]->{client}->put("got error: $@");
59: - } else {
60: - $_[HEAP]->{client}->put("done");
61: - }
62: - },
63: - got_client_error => sub {
64: - my($syscall,$errno,$error)=@_[ARG0..ARG2];
65: - $error = "Normal disconnection." unless $errno;
66: - $rrd->log("Server session encounterd %s error %d: %s",
67: - $syscall, $errno, $error);
68: - $_[KERNEL]->yield('_exit');
69: - },
70: - },
71: - args => [$_[ARG0]],
72: - );
73: - },
74: - got_error => sub {
75: - my($syscall,$errno,$error)=@_[ARG0..ARG2];
76: - $error = "Normal disconnection." unless $errno;
77: - $rrd->log("Server socket encounterd %s error %d: %s",
78: - $syscall, $errno, $error);
79: - $_[KERNEL]->yield('_exit');
80: - },
81: - },
82: - );
83: - }
84: + $rrd->server_init();
85: $_[HEAP]->{cron} = $cron;
86: $_[HEAP]->{rrd} = $rrd;
87: $_[KERNEL]->alarm_set('rrd_temp', $cron->next()->epoch());
88: @@ -236,7 +160,7 @@
89: $_[KERNEL]->sig('USR2', 'sigusr2');
90: },
91: _exit => sub {
92: - $_[KERNEL]->post(socket => '_exit');
93: + $_[HEAP]->{rrd}->server_exit(@_);
94: },
95: rrd_temp => sub {
96: my $cron = $_[HEAP]->{cron};
この引っ越しにあたり、 ひとつだけ、$rrdというレキシカル変数を参照していた部分は、 $selfという自身のインスタンスに置換しています。 その程度の修正で済んでしまうあたりが、Perl OOPの柔軟なところですね:-)
1: --- shell.pm 2003/09/15 06:53:10 6.3
2: +++ shell.pm 2003/09/21 14:20:18 7.1
3: @@ -76,4 +76,92 @@
4: $self;
5: }
6:
7: +use POE;
8: +
9: +sub server_init {
10: + my $self = shift;
11: + POE::Session->create
12: + (
13: + inline_states =>
14: + {
15: + _start => sub {
16: + my $socket_rendezvous = '/tmp/rrd-temp-rendezvous';
17: + unlink $socket_rendezvous if -e $socket_rendezvous;
18: + eval {
19: + use Socket;
20: + use POE::Wheel::SocketFactory;
21: + };
22: + $_[HEAP]->{socket} = POE::Wheel::SocketFactory->new
23: + (
24: + SocketDomain => PF_UNIX,
25: + BindAddress => $socket_rendezvous,
26: + SuccessEvent => 'got_client',
27: + FailureEvent => 'got_error',
28: + );
29: + $_[KERNEL]->alias_set('socket');
30: + },
31: + _exit => sub {
32: + $_[KERNEL]->post(client => '_exit');
33: + delete $_[HEAP]->{socket};
34: + },
35: + got_client => sub {
36: + POE::Session->create
37: + (
38: + inline_states =>
39: + {
40: + _start => sub {
41: + eval {
42: + use POE::Wheel::ReadWrite;
43: + };
44: + $_[HEAP]->{client} = POE::Wheel::ReadWrite->new
45: + (
46: + Handle => $_[ARG0],
47: + InputEvent => 'got_client_input',
48: + ErrorEvent => 'got_client_error',
49: + );
50: + $_[KERNEL]->alias_set('client');
51: + $_[HEAP]->{client}->put("Welcome to RRDs::rrd::temp [$$].");
52: + },
53: + _exit => sub {
54: + delete $_[HEAP]->{client};
55: + },
56: + got_client_input => sub {
57: + $_[HEAP]->{client}->put("executing $_[ARG0]...");
58: + eval { my $cmd = $_[ARG0]; $self->$cmd(); };
59: + if ($@) {
60: + chomp $@;
61: + $_[HEAP]->{client}->put("got error: $@");
62: + } else {
63: + $_[HEAP]->{client}->put("done");
64: + }
65: + },
66: + got_client_error => sub {
67: + my($syscall,$errno,$error)=@_[ARG0..ARG2];
68: + $error = "Normal disconnection." unless $errno;
69: + $self->log("Server session encounterd %s error %d: %s",
70: + $syscall, $errno, $error);
71: + $_[KERNEL]->yield('_exit');
72: + },
73: + },
74: + args => [$_[ARG0]],
75: + );
76: + },
77: + got_error => sub {
78: + my($syscall,$errno,$error)=@_[ARG0..ARG2];
79: + $error = "Normal disconnection." unless $errno;
80: + $self->log("Server socket encounterd %s error %d: %s",
81: + $syscall, $errno, $error);
82: + $_[KERNEL]->yield('_exit');
83: + },
84: + },
85: + );
86: + $self;
87: +}
88: +
89: +sub server_exit {
90: + my $self = shift;
91: + $_[KERNEL]->post(socket => '_exit');
92: + $self;
93: +}
94: +
95: 1;
Posted by Manabu Higashida at 02:15 PM
| Comments (0)
September 21, 2003
graceful shutdown once more
やはり、_stop
イベントを
ユーザスクリプト内で発効するのは間違っているので、
_exit
イベントに対するハンドラとして記述し直しました
(このシンボル名も後々誤解を産む元になるかもしれませんが...)。
以前のコーディングでは、
SIGTERMシグナルを受け取った際に、
clientというエリアスを設定したPOEセッションと、
socketというエリアスを設定したPOEセッションに
個別にイベントを発効していましたが、
ブロックの依存関係を明確にするために自身に_exit
イベントを発効し、
そこから順繰り芋蔓式に依存関係を辿って
graceful shutdown
に導くように変更しています:
1: --- temp.pl 2003/09/21 05:07:53 7.3
2: +++ temp.pl 2003/09/21 14:04:48 7.4
3: @@ -170,7 +170,8 @@
4: );
5: $_[KERNEL]->alias_set('socket');
6: },
7: - _stop => sub {
8: + _exit => sub {
9: + $_[KERNEL]->post(client => '_exit');
10: delete $_[HEAP]->{socket};
11: },
12: got_client => sub {
13: @@ -191,7 +192,7 @@
14: $_[KERNEL]->alias_set('client');
15: $_[HEAP]->{client}->put("Welcome to RRDs::rrd::temp [$$].");
16: },
17: - _stop => sub {
18: + _exit => sub {
19: delete $_[HEAP]->{client};
20: },
21: got_client_input => sub {
22: @@ -209,7 +210,7 @@
23: $error = "Normal disconnection." unless $errno;
24: $rrd->log("Server session encounterd %s error %d: %s",
25: $syscall, $errno, $error);
26: - $_[KERNEL]->post(client => '_stop');
27: + $_[KERNEL]->yield('_exit');
28: },
29: },
30: args => [$_[ARG0]],
31: @@ -220,7 +221,7 @@
32: $error = "Normal disconnection." unless $errno;
33: $rrd->log("Server socket encounterd %s error %d: %s",
34: $syscall, $errno, $error);
35: - $_[KERNEL]->post(socket => '_stop');
36: + $_[KERNEL]->yield('_exit');
37: },
38: },
39: );
40: @@ -234,6 +235,9 @@
41: $_[KERNEL]->sig('USR1', 'sigusr1');
42: $_[KERNEL]->sig('USR2', 'sigusr2');
43: },
44: + _exit => sub {
45: + $_[KERNEL]->post(socket => '_exit');
46: + },
47: rrd_temp => sub {
48: my $cron = $_[HEAP]->{cron};
49: my $rrd = $_[HEAP]->{rrd};
50: @@ -253,8 +257,7 @@
51: $_[KERNEL]->sig_handled();
52: $_[HEAP]->{rrd}->sigterm();
53: $_[HEAP]->{rrd}->log("$0 has terminated");
54: - $_[KERNEL]->post(client => '_stop');
55: - $_[KERNEL]->post(socket => '_stop');
56: + $_[KERNEL]->yield('_exit');
57: $_[KERNEL]->alarm_remove_all();
58: },
59: sigusr1 => sub {
Posted by Manabu Higashida at 02:15 PM
| Comments (0)
September 20, 2003
command execution
ともかく、graceful shutdown
するようになったので、
受け取った文字列をコマンドとして解釈し何かを実行するように実装してみましょう。
CPAN のシェルの実装から拝借したアイデアですが、 次のように記述して、受け取った文字列をRRDs::rrdのメソッドとして起動するようにしてみました:
1: --- temp.pl 2003/09/21 05:05:56 7.2
2: +++ temp.pl 2003/09/21 05:07:53 7.3
3: @@ -195,7 +195,14 @@
4: delete $_[HEAP]->{client};
5: },
6: got_client_input => sub {
7: - $_[HEAP]->{client}->put($_[ARG0]);
8: + $_[HEAP]->{client}->put("executing $_[ARG0]...");
9: + eval { my $cmd = $_[ARG0]; $rrd->$cmd(); };
10: + if ($@) {
11: + chomp $@;
12: + $_[HEAP]->{client}->put("got error: $@");
13: + } else {
14: + $_[HEAP]->{client}->put("done");
15: + }
16: },
17: got_client_error => sub {
18: my($syscall,$errno,$error)=@_[ARG0..ARG2];
これにより、次のようなセッションの実行が可能になります:
$ perl ./ucli.pl /tmp/rrd-temp-rendezvous Server Said: Welcome to RRDs::rrd::temp [30425]. => update You Said: update Server Said: executing update... Server Said: done => graph You Said: graph Server Said: executing graph... Server Said: done => ls You Said: ls Server Said: executing ls... Server Said: got error: Can't locate object method "ls" via package "RRDs::temp" at RRDs/shell.pm line 130. => ^C Bye.
このように、デーモン化されたプロセスに接続し、 とにかくメソッドを起動することができます。 引数の受け渡しも可能なように記述できますが未実装です。 なお、実装されていないメソッドを起動しようとすると、 最後のやりとりのようなエラーになります。
Posted by Manabu Higashida at 11:13 PM
| Comments (0)
September 19, 2003
graceful shutdown again
「オウム返し」ではつまりませんので、早速サーバ機能を拡充したいところですが、
実際に接続していろいろと実験してみると、
graceful shutdown
しないことがわかってしまいました。
ちょっと不便です。
POEのカーネルは、イベントキューに処理すべきイベントが無くなった場合にのみ
「上品な終了」が行われるのですが、
クライアントの接続要求を待っているUnix Domainソケットが
わだかまっていると元のコーディングのままでは終了しないようです。
これを回避するために、次のようにSIGTERMを受け取ったときに
明示的に_stop
イベントのハンドラを起動して、
ソケットの口を開けて待っているオブジェクトを削除するように修正してみました:
1: --- temp.pl 2003/09/21 05:01:54 7.1
2: +++ temp.pl 2003/09/21 05:05:56 7.2
3: @@ -168,6 +168,10 @@
4: SuccessEvent => 'got_client',
5: FailureEvent => 'got_error',
6: );
7: + $_[KERNEL]->alias_set('socket');
8: + },
9: + _stop => sub {
10: + delete $_[HEAP]->{socket};
11: },
12: got_client => sub {
13: POE::Session->create
14: @@ -184,8 +188,12 @@
15: InputEvent => 'got_client_input',
16: ErrorEvent => 'got_client_error',
17: );
18: + $_[KERNEL]->alias_set('client');
19: $_[HEAP]->{client}->put("Welcome to RRDs::rrd::temp [$$].");
20: },
21: + _stop => sub {
22: + delete $_[HEAP]->{client};
23: + },
24: got_client_input => sub {
25: $_[HEAP]->{client}->put($_[ARG0]);
26: },
27: @@ -194,7 +202,7 @@
28: $error = "Normal disconnection." unless $errno;
29: $rrd->log("Server session encounterd %s error %d: %s",
30: $syscall, $errno, $error);
31: - delete $_[HEAP]->{client};
32: + $_[KERNEL]->post(client => '_stop');
33: },
34: },
35: args => [$_[ARG0]],
36: @@ -205,7 +213,7 @@
37: $error = "Normal disconnection." unless $errno;
38: $rrd->log("Server socket encounterd %s error %d: %s",
39: $syscall, $errno, $error);
40: - delete $_[HEAP]->{socket};
41: + $_[KERNEL]->post(socket => '_stop');
42: },
43: },
44: );
45: @@ -238,6 +246,8 @@
46: $_[KERNEL]->sig_handled();
47: $_[HEAP]->{rrd}->sigterm();
48: $_[HEAP]->{rrd}->log("$0 has terminated");
49: + $_[KERNEL]->post(client => '_stop');
50: + $_[KERNEL]->post(socket => '_stop');
51: $_[KERNEL]->alarm_remove_all();
52: },
53: sigusr1 => sub {
しかし、_stop
イベントは、
_start
と対の処理で、
カーネルが終了する際に発生するイベントなので、
このイベントをユーザーコードで明示的に発効するのは
何か激しく間違っているような気がしますね...:-P。
Posted by Manabu Higashida at 11:13 PM
| Comments (0)
September 18, 2003
telnet to AF_UNIX
POE Cookbookの
UNIX Servers
の冒頭で触れられているように、
BSD派生のtelnetは-uオプションでランデブー・ポイントを指定すると
Unix Domainソケットに接続できるはずですが
(4.3BSD以降でしょうか。
Mac OS Xのtelnetは4.2BSD派生で残念ながら実装されていませんでした)、
RedHatが採用している
NetKit版 telnet
| NetKit版 telnet |
そのため、POE Cookbookでは、先のUnix Servers
に接続するためのクライアント
UNIX Clients
が提供されています。
$ perl ./ucli.pl /tmp/rrd-temp-rendezvous Server Said: Welcome to RRDs::rrd::temp [30425]. => whoami You Said: whoami Server Said: whoami => ^C Bye.のように実行すれば先のサーバコードを実装したRRDs::tempサーバに接続し、 対話的な操作をすることができます。 といっても、サーバにはまだ「オウム返し」しか実装していませんが...:-P
Posted by Manabu Higashida at 11:13 PM
| Comments (0)
September 17, 2003
listen with AF_UNIX
Daemonizeしたプロセスにアタッチする一般的な手法が、 ソケットによるストリーム通信です。いえ、逆かもしれません:-P ソケットによるストリーム通信サービスを安定して提供するために daemonize処理が必要なんですが...。
ともかく、POEを使っている限り、
プロセスにその種の通信チャネルを設けることはいとも簡単です。
POE Cookbookには、Unix Domainソケット
(AF_UNIXという識別子で指定します) を作って
サービスを提供するためのサンプル
UNIX Servers
が登録されています。
これを組み込んでみました:
UNIX Servers
1: --- temp.pl 2003/09/15 09:12:56 6.7
2: +++ temp.pl 2003/09/21 05:01:54 7.1
3: @@ -149,6 +149,67 @@
4: my $crontab = step2crontab($rrd->{step});
5: $rrd->log("$0 started with $crontab");
6: my $cron = DateTime::Event::Cron->new_from_cron($crontab);
7: + {
8: + POE::Session->create
9: + (
10: + inline_states =>
11: + {
12: + _start => sub {
13: + my $socket_rendezvous = '/tmp/rrd-temp-rendezvous';
14: + unlink $socket_rendezvous if -e $socket_rendezvous;
15: + eval {
16: + use Socket;
17: + use POE::Wheel::SocketFactory;
18: + };
19: + $_[HEAP]->{socket} = POE::Wheel::SocketFactory->new
20: + (
21: + SocketDomain => PF_UNIX,
22: + BindAddress => $socket_rendezvous,
23: + SuccessEvent => 'got_client',
24: + FailureEvent => 'got_error',
25: + );
26: + },
27: + got_client => sub {
28: + POE::Session->create
29: + (
30: + inline_states =>
31: + {
32: + _start => sub {
33: + eval {
34: + use POE::Wheel::ReadWrite;
35: + };
36: + $_[HEAP]->{client} = POE::Wheel::ReadWrite->new
37: + (
38: + Handle => $_[ARG0],
39: + InputEvent => 'got_client_input',
40: + ErrorEvent => 'got_client_error',
41: + );
42: + $_[HEAP]->{client}->put("Welcome to RRDs::rrd::temp [$$].");
43: + },
44: + got_client_input => sub {
45: + $_[HEAP]->{client}->put($_[ARG0]);
46: + },
47: + got_client_error => sub {
48: + my($syscall,$errno,$error)=@_[ARG0..ARG2];
49: + $error = "Normal disconnection." unless $errno;
50: + $rrd->log("Server session encounterd %s error %d: %s",
51: + $syscall, $errno, $error);
52: + delete $_[HEAP]->{client};
53: + },
54: + },
55: + args => [$_[ARG0]],
56: + );
57: + },
58: + got_error => sub {
59: + my($syscall,$errno,$error)=@_[ARG0..ARG2];
60: + $error = "Normal disconnection." unless $errno;
61: + $rrd->log("Server socket encounterd %s error %d: %s",
62: + $syscall, $errno, $error);
63: + delete $_[HEAP]->{socket};
64: + },
65: + },
66: + );
67: + }
68: $_[HEAP]->{cron} = $cron;
69: $_[HEAP]->{rrd} = $rrd;
70: $_[KERNEL]->alarm_set('rrd_temp', $cron->next()->epoch());
POEのセッションを生成し (この位置だと子セッションになります)、 ランデブー・ポイントを指定してUnix Domainソケットを作って待ち受けに入ります (12-26行目)。 クライアントからの接続要求が合ったときは、さらに子セッションを生成し、 入力された文字列をそのまま「オウム返し」に返します (27-57行目)。 58-64行目まではエラー処理です (47-53行目も同様)。
POE Cookbookの例はハンドラを通常の関数 (タイプグロブにバインドされたコード) として定義しそれを登録していますが、 ここではクロージャによる匿名関数をインラインで記述しています。 ですので、ここに追加したブロック以外の変更はありません。 これ以上複雑な記述になると可読性が落ちるかもしれませんが、 逆に、この程度の記述に収めることによって、 スクリプトの可読性は元のサンプルよりも遙かに向上したと思います。
Posted by Manabu Higashida at 11:12 PM
| Comments (0)
September 16, 2003
using gdb to attach
プロセスのdetach
は定型的な処理なので、
その通り実行すればいいのですけど、
その逆に、ひとたびdaemonizeしたプロセスにattach
する手法は、
千差万別、よりどりみどり、定型などありません。
例えば、
次の例のように定期的にハンドラを呼び出すプログラムを記述したとしましょう
(この例ではdaemonizeは行っていませんが、
setsid
コマンドから起動すれば簡略にデーモン化することはできます)。
1: #include <stdio.h>
2:
3: void
4: hdlr ()
5: {
6: printf("HELO\n");
7: }
8:
9: main ()
10: {
11: while (1) {
12: hdlr();
13: sleep(60);
14: }
15: }
この例では60秒ごとにハンドラを実行していますので、
何かの都合でハンドラを例外的に実行したくなったとしても、
次の定時実行を待つこともギリギリ許容できるかもしれませんが、
これが60分に設定されていて、
サービスの都合でこのプロセスを容易に終了できないとしたら、
さて、いったいどうしましょうか。
ひとつの解決法は、次のようにあらかじめシグナル・ハンドラとして登録しておき、 シグナル発効によって随時ハンドラを起動できるように仕掛けておくことです。
1: #include <stdio.h>
2: #include <signal.h>
3:
4: void
5: hdlr (sig)
6: int sig;
7: {
8: printf("HELO: %d\n", sig);
9: }
10:
11: main ()
12: {
13: signal(SIGHUP, hdlr);
14: while (1) {
15: hdlr();
16: sleep(60);
17: }
18: }
こうしておけば、
プロセスにSIGHUPシグナルを発効することで随時ハンドラを呼び出すことができます。
ただし、これはこれまでのPerlへの実装例でも見たように、
提供されている汎用シグナル数の制約から多機能化に制約があります。
なお、ハンドリングしているシグナルを受信すると、
ハンドラ呼び出し後にsleep()によるタイマーはリセットされます。
それに対して、次のようにデバッガでプロセスにattachし、 ハンドラを呼び出すやり方もあります。
1: $ gdb ./a.out `pidof -s a.out` 2: GNU gdb Red Hat Linux (5.3post-0.20021129.18rh) 3: Copyright 2003 Free Software Foundation, Inc. 4: GDB is free software, covered by the GNU General Public License, and you are 5: welcome to change it and/or distribute copies of it under certain conditions. 6: Type "show copying" to see the conditions. 7: There is absolutely no warranty for GDB. Type "show warranty" for details. 8: This GDB was configured as "i386-redhat-linux-gnu"... 9: Attaching to program: /var/www/html/higashida.net/manabu/qhr/asp/rrd/a.out, process 2928sleep()スタックフレームからhdlr()を呼び出すのは、一見強引なような気もしますが、 通常のシグナル・ハンドリングでも同様のスタックフレームから処理されるので、 そもそもハンドラはそれを前提に気を配って記述する必要があります。 なお、デバッガでattachすることによって、 プロセスにはSIGTRAPシグナルが送られるので、 detachする際にsleep()タイマはリセットされます。
さて、この手法をPerlスクリプトに適用することは可能でしょうか？ Perl関数のエントリ・ポイントが分からないことには、 デバッガからPerl関数を実行しようがありません。 そのための逐一XSライブラリを記述することも不可能ではありませんが、 それはまた面倒です。 もっと別の方法を考えた方が良さそうですね...。
Posted by Manabu Higashida at 12:28 PM
| Comments (0)
September 15, 2003
daemon control with signaling
SIGHUPシグナルによる再ロードですが、 Proc::Daemon モジュールを使ってデーモン化すると、 Proc::Daemon::Init()内でSIGHUPがグラブされて無効化されてしまうので、 効き目を失ってしまいます。 SIGUSR1シグナルでグラフ化を行うように変更するついでに、 次のようにSIGUSR2シグナルで再ロードを行うように変更しました:
1: --- temp.pl 2003/09/15 08:54:33 6.3.1.1
2: +++ temp.pl 2003/09/15 09:02:42 6.5
3: @@ -96,6 +96,20 @@
4: return $self->SUPER::graph(@args);
5: }
6:
7: +sub sigusr1 {
8: + my $self = shift;
9: + $self->log("got [$$]: sigusr1");
10: + $self->graph();
11: + $self;
12: +}
13: +
14: +sub sigusr2 {
15: + my $self = shift;
16: + $self->log("got [$$]: sigusr2");
17: + $self->reload();
18: + $self;
19: +}
20: +
21: package main;
22:
23: use POE;
24: @@ -141,6 +155,8 @@
25: $_[KERNEL]->sig('HUP', 'sighup');
26: $_[KERNEL]->sig('INT', 'sigint');
27: $_[KERNEL]->sig('TERM', 'sigterm');
28: + $_[KERNEL]->sig('USR1', 'sigusr1');
29: + $_[KERNEL]->sig('USR1', 'sigusr2');
30: },
31: rrd_temp => sub {
32: my $cron = $_[HEAP]->{cron};
33: @@ -162,6 +178,14 @@
34: $_[HEAP]->{rrd}->sigterm();
35: $_[KERNEL]->alarm_remove_all();
36: },
37: + sigusr1 => sub {
38: + $_[KERNEL]->sig_handled();
39: + $_[HEAP]->{rrd}->sigusr1();
40: + },
41: + sigusr2 => sub {
42: + $_[KERNEL]->sig_handled();
43: + $_[HEAP]->{rrd}->sigusr2();
44: + },
45: },
46: );
47:
さて、このように次々のユーザ定義シグナルに機能を割り当てて行きたいところではありますが、 ユーザー定義シグナルはいきなりSIGUSR2で打ち止めで SIGUSR3はありません:-P ここから先はまったく異なる手段でデーモン制御を実装してみましょう。
Posted by Manabu Higashida at 10:56 PM
| Comments (0)
モジュールの再ロード
モジュールの再ロード機能をRRDs::shellパッケージに組み込みました。 SIGHUPシグナルを受け取ったときにRRDs::shell::reload()を呼び出し、 インスタンス変数reloadに登録されたファイルを順次再ロードします:
1: --- shell.pm 2003/09/15 09:43:35 6.2.1.1
2: +++ shell.pm 2003/09/15 06:53:10 6.3
3: @@ -20,6 +20,7 @@
4: return if $self->{new}{&package_name()}++;
5: my %args = @_;
6: {
7: + $self->{reload} = delete $args{reload};
8: $self->{cwd} = delete $args{cwd};
9: chdir($self->{cwd})
10: if ( defined $self->{daemonize} && defined $self->{cwd} );
11: @@ -34,9 +35,23 @@
12: $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
13: }
14:
15: +sub reload {
16: + my $self = shift;
17: + foreach my $file ( @{$self->{reload}} ) {
18: + $self->log("reloading the whole $file");
19: + eval { use FileHandle (); };
20: + my $fh = FileHandle->new($INC{$file});
21: + local($/);
22: + eval <$fh>;
23: + $self->log($@) if $@;
24: + }
25: + $self;
26: +}
27: +
28: sub sighup {
29: my $self = shift;
30: $self->log("got [$$]: sighup");
31: + $self->reload();
32: $self;
33: }
34:
呼び出し側のスクリプトでは、15行目のように再ロード対象となるファイルのリストを設定します:
1: --- temp.pl 2003/09/15 06:25:13 6.2
2: +++ temp.pl 2003/09/15 06:52:08 6.3
3: @@ -103,6 +103,7 @@
4: use Getopt::Std;
5: use Time::HiRes qw(time);
6: use POSIX;
7: +use RRDs::cron qw(step2crontab);
8: use strict;
9:
10: my $cwd;
11: @@ -128,9 +129,10 @@
12: daemonize => !$opt_d,
13: tz => 'JST-9',
14: cwd => $cwd,
15: + reload => [qw(RRDs/rrd.pm)],
16: );
17: $rrd->load_info();
18: - my $crontab = $rrd->step2crontab();
19: + my $crontab = step2crontab($rrd->{step});
20: print STDERR $crontab, "\n" if defined $opt_d;
21: my $cron = DateTime::Event::Cron->new_from_cron($crontab);
22: $_[HEAP]->{cron} = $cron;
さて、ここで困ったことがひとつ。 上のパッチでごそごそと作業をしているように、 Damian Conway作のSwitch.pm を 使って実装したRRDs::rrd::step2crontab()関数を、RRDs::rrdパッケージから追い出しました。 再ロードするとパーザがエラーを起こしてしまうのです。 こればっかりは手の打ちようがあまりないので、早々に見切らなくてはなりませんが、 まぁ、こういうことって現実的に起こりうるんですよねぇ...。 ともかく、これでプロセスにSIGHUPシグナルを発効すると RRDs::rrdパッケージが再ロードされるようになりました:
1: #!/usr/bin/perl
2: # $Id: cron.pm,v 6.1 2003/09/15 06:52:30 manabu Exp $
3: # Copyright (C) 2003 by Manabu Higashida, All rights reserved.
4:
5: package RRDs::cron;
6: use strict qw(vars);
7: use Carp;
8: use Exporter ();
9: use vars qw(@ISA @EXPORT);
10: @ISA = qw(Exporter);
11: @EXPORT = qw(step2crontab);
12:
13: sub step2crontab {
14: my $step = shift || 1800;
15: my $divide = sub { $_[0]/$_[1] };
16: croak "out of range: $step" if ( $step < 60 || $step > 86400 );
17: eval { use Switch; };
18: switch ( $step ) {
19: case 60 { return "* * * * *" } # minutely
20: case 3600 { return "0 * * * *" } # hourly
21: case 86400 { return "0 0 * * *" } # daily
22: else {
23: croak "too fractional: $step" if $step % 60;
24: my $m = int(&$divide($step,60));
25: switch ( sub { $_[0] > $step } ) {
26: case 3600 {
27: croak "not a factor of 60: $m minutes" if 60 % $m;
28: return sprintf("*\/%d * * * *", $m);
29: }
30: case 86400 {
31: croak "too fractional: $step" if $m % 60;
32: my $h = int(&$divide($step,60*60));
33: croak "not a factor of 24: $h hours" if 24 % $h;
34: return sprintf ("0 *\/%d * * *", $h)
35: }
36: }
37: }
38: }
39: }
40:
41: 1;
Posted by Manabu Higashida at 03:57 PM
| Comments (0)
September 14, 2003
new() and/or init()
コンストラクタに与える引数を、継承するクラスのコンストラクタを呼び出す際に すべて引き回すのは無駄ですし、予期せぬバグを産みそうなので、 渡された引数をインスタンス変数に格納すると同時に削除するよう、 ちょこまかと変更を加えました。 本来は、init()とという関数を別途設けるといいのかもしれませんが、 それはそれでまた管理が面倒になりそうなので、今回は使いませんでした。
1: --- rrd.pm 2003/09/14 03:01:36 6.1
2: +++ rrd.pm 2003/09/15 06:26:21 6.2
3: @@ -24,20 +24,24 @@
4: my $proto = shift;
5: my $self = (ref($proto) ? $proto : bless {}, $proto);
6: return if $self->{new}{&package_name()}++;
7: - $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
8: - my %params = @_;
9: - $self->{debug} = $params{debug};
10: - $self->{dryrun} = $params{dryrun} || $self->{debug} ;
11: - $self->{daemonize} = ( defined $self->{debug} ? undef : $params{daemonize});
12: - $self->{basename} = $params{basename};
13: - if ( $params{tz} =~ /^([A-Z]+)([+-]*\d+)$/ ) {
14: + my %args = @_;
15: + {
16: + $self->{debug} = delete $args{debug};
17: + $self->{dryrun} = delete $args{dryrun} || $self->{debug} ;
18: + $self->{daemonize} = ( defined $self->{debug}
19: + ? undef : delete $args{daemonize} );
20: + $self->{basename} = delete $args{basename};
21: + $self->{rrd} = "rrd/$self->{basename}.rrd";
22: + $self->{img} = "img/$self->{basename}";
23: + $self->{tz} = delete $args{tz};
24: + if ( $self->{tz} =~ /^([A-Z]+)([+-]*\d+)$/ ) {
25: $self->{tz_std} = $1;
26: $self->{tz_offset} = $2;
27: $ENV{TZ} = "$self->{tz_std}"; # set tz without tz_offset
28: POSIX::tzset();
29: }
30: - $self->{rrd} = "rrd/$self->{basename}.rrd";
31: - $self->{img} = "img/$self->{basename}";
32: + }
33: + $self->$_(%args) for ( map { $_->can("new") || () } @ISA );
34: $self;
35: }
36:
1: --- shell.pm 2003/09/14 03:01:32 6.1
2: +++ shell.pm 2003/09/15 06:25:54 6.2
3: @@ -18,9 +18,13 @@
4: my $proto = shift;
5: my $self = (ref($proto) ? $proto : bless {}, $proto);
6: return if $self->{new}{&package_name()}++;
7: - if ( defined $self->{daemonize} ) {
8: - chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
9: + my %args = @_;
10: + {
11: + $self->{cwd} = delete $args{cwd};
12: + chdir($self->{cwd})
13: + if ( defined $self->{daemonize} && defined $self->{cwd} );
14: }
15: + $self->$_(%args) for ( map { $_->can("new") || () } @ISA );
16: $self;
17: }
18:
1: --- log.pm 2003/09/14 03:01:24 6.1
2: +++ log.pm 2003/09/15 06:25:36 6.2
3: @@ -15,7 +15,7 @@
4: my $proto = shift;
5: my $self = (ref($proto) ? $proto : bless {}, $proto);
6: return if $self->{new}{&package_name()}++;
7: - $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
8: + {
9: $self->{rbuf_max} = 10;
10: $self->{rbuf} = ();
11: $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
12: @@ -23,6 +23,8 @@
13: eval { use Sys::Syslog; };
14: openlog("$self->{basename}", "pid", "user");
15: }
16: + }
17: + $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
18: $self;
19: }
20:
1: --- temp.pl 2003/09/14 03:01:14 6.1
2: +++ temp.pl 2003/09/15 06:25:13 6.2
3: @@ -16,11 +16,13 @@
4: my $proto = shift;
5: my $self = (ref($proto) ? $proto : bless {}, $proto);
6: return if $self->{new}{&package_name()}++;
7: - $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
8: + {
9: $self->{host} = $ARGV[0] || 'localhost';
10: $self->{pass} = '';
11: $self->{community} = 'public';
12: $self->{objid} = '.1.3.6.1.4.1.674.10892.1.700.20.1.6';
13: + }
14: + $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
15: $self;
16: }
17:
18: @@ -100,11 +102,14 @@
19: use DateTime::Event::Cron;
20: use Getopt::Std;
21: use Time::HiRes qw(time);
22: +use POSIX;
23: use strict;
24:
25: +my $cwd;
26: our($opt_d);
27: getopts('d');
28: unless (defined $opt_d) {
29: + $cwd = POSIX::cwd();
30: eval { use Proc::Daemon; };
31: Proc::Daemon::Init();
32: } else {
33: @@ -116,7 +121,14 @@
34: inline_states =>
35: {
36: _start => sub {
37: - my $rrd = RRDs::temp->new( basename => 'temp', debug => $opt_d, daemonize => !$o
pt_d, tz => 'JST-9', );
38: + my $rrd = RRDs::temp->new
39: + (
40: + basename => 'temp',
41: + debug => $opt_d,
42: + daemonize => !$opt_d,
43: + tz => 'JST-9',
44: + cwd => $cwd,
45: + );
46: $rrd->load_info();
47: my $crontab = $rrd->step2crontab();
48: print STDERR $crontab, "\n" if defined $opt_d;
Posted by Manabu Higashida at 10:55 PM
| Comments (0)
ダイヤモンド継承
その際問題になるのは、RRDs::logのダイヤモンド継承です。 すなわち、RRDs::rrdとRRDs::shellを多重継承したクラスのインスタンスの生成・消滅時に、 RRDs::logのコンストラクタとデストラクタが複数回呼び出されることになります。 これは致命的なバグを引き起こすことがあります (Perlはルーズなので、それ程致命的にはならないでしょうが、 解析困難なバグの原因にはなりますね)。
それを回避するために、 インスタンス変数にコンストラクタとデストラクタの呼び出し回数を格納するハッシュを持たせ、 同一パッケージのコンストラクタ・デストラクタを複数回呼び出さないように変更を加えました:
1: --- temp.pl 2003/09/14 02:11:18 5.1
2: +++ temp.pl 2003/09/14 02:55:13 5.2
3: @@ -7,9 +7,14 @@
4: use RRDs::rrd;
5: @ISA = qw(RRDs::rrd RRDs::shell);
6:
7: +{
8: + sub package_name { __PACKAGE__ };
9: +}
10: +
11: sub new {
12: my $proto = shift;
13: my $self = (ref($proto) ? $proto : bless {}, $proto);
14: + return if $self->{new}{&package_name()}++;
15: $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
16: $self->{host} = $ARGV[0] || 'localhost';
17: $self->{pass} = '';
18: @@ -20,6 +25,7 @@
19:
20: sub DESTROY {
21: my $self = shift;
22: + return if $self->{DESTROY}{&package_name()}++;
23: $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
24: }
25:
1: --- rrd.pm 2003/09/14 02:25:56 5.2
2: +++ rrd.pm 2003/09/14 02:51:43 5.3
3: @@ -3,7 +3,8 @@
4: # Copyright (C) 2003 by Manabu Higashida, All rights reserved.
5:
6: package RRDs::rrd;
7: -@RRDs::rrd::ISA = qw(RRDs::log);
8: +use vars qw(@ISA);
9: +@ISA = qw(RRDs::log);
10:
11: use strict;
12: use Carp;
13: @@ -14,9 +15,15 @@
14: unshift(@INC, '/usr/local/rrdtool/lib/perl');
15: require 'RRDs.pm';
16:
17: +{
18: + sub package_name { __PACKAGE__ };
19: +}
20: +
21: sub new {
22: my $proto = shift;
23: my $self = (ref($proto) ? $proto : bless {}, $proto);
24: + return if $self->{new}{&package_name()}++;
25: + $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
26: my %params = @_;
27: $self->{debug} = $params{debug};
28: $self->{dryrun} = $params{dryrun} || $self->{debug} ;
29: @@ -33,9 +40,11 @@
30: $self;
31: }
32:
33: -# sub DESTROY {
34: -# my $self = shift;
35: -# }
36: +sub DESTROY {
37: + my $self = shift;
38: + return if $self->{DESTROY}{&package_name()}++;
39: + $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
40: +}
41:
42:
43: # RRDs::create unless exists rrd
44: @@ -292,12 +301,19 @@
45: }
46:
47: package RRDs::log;
48: +use vars qw(@ISA);
49:
50: use strict;
51:
52: +{
53: + sub package_name { __PACKAGE__ };
54: +}
55: +
56: sub new {
57: my $proto = shift;
58: my $self = (ref($proto) ? $proto : bless {}, $proto);
59: + return if $self->{new}{&package_name()}++;
60: + $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
61: $self->{rbuf_max} = 10;
62: $self->{rbuf} = ();
63: $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
64: @@ -310,6 +326,8 @@
65:
66: sub DESTROY {
67: my $self = shift;
68: + return if $self->{DESTROY}{&package_name()}++;
69: + $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
70: if ( defined $self->{daemonize} ) {
71: closelog();
72: } else {
73: @@ -333,23 +351,31 @@
74:
75:
76: package RRDs::shell;
77: -@RRDs::shell::ISA = qw(RRDs::log);
78: +use vars qw(@ISA);
79: +@ISA = qw(RRDs::log);
80:
81: use strict;
82: use Data::Dumper;
83:
84: +{
85: + sub package_name { __PACKAGE__ };
86: +}
87: +
88: sub new {
89: my $proto = shift;
90: my $self = (ref($proto) ? $proto : bless {}, $proto);
91: + return if $self->{new}{&package_name()}++;
92: if ( defined $self->{daemonize} ) {
93: chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
94: }
95: $self;
96: }
97:
98: -# sub DESTROY {
99: -# my $self = shift;
100: -# }
101: +sub DESTROY {
102: + my $self = shift;
103: + return if $self->{DESTROY}{&package_name()}++;
104: + $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
105: +}
106:
107: sub sighup {
108: my $self = shift;
これもDamian ConwayのOOP本のアイデアですが、 彼の本では、
return if $self->{new}{__PACKAGE__}++;
のように記載されていますが、この__PACKAGE__というベアワードは ハッシュのキーというコンテキストでは評価されないので、 一旦変数に格納してからハッシュ・キーとして参照するか、 上述したように、定数を返す関数のようにコーディングする必要があります (たぶん最近のPerlでは...)。
Posted by Manabu Higashida at 11:26 AM
| Comments (0)
September 13, 2003
RRDs::log
さらにログ出力の部分は、RRDs::rrdとRRDs::shellに共通なので、 別パッケージ化して、RRDs::rrdとRRDs::shellはRRDs::logを継承するようにしました:
1: --- rrd.pm 2003/09/14 02:28:28 5.1.1.1
2: +++ rrd.pm 2003/09/14 02:25:56 5.2
3: @@ -3,6 +3,7 @@
4: # Copyright (C) 2003 by Manabu Higashida, All rights reserved.
5:
6: package RRDs::rrd;
7: +@RRDs::rrd::ISA = qw(RRDs::log);
8:
9: use strict;
10: use Carp;
11: @@ -290,11 +291,9 @@
12: }
13: }
14:
15: -package RRDs::shell;
16: +package RRDs::log;
17:
18: use strict;
19: -use Carp;
20: -use Data::Dumper;
21:
22: sub new {
23: my $proto = shift;
24: @@ -304,7 +303,6 @@
25: $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
26: if ( defined $self->{daemonize} ) {
27: eval { use Sys::Syslog; };
28: - chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
29: openlog("$self->{basename}", "pid", "user");
30: }
31: $self;
32: @@ -333,6 +331,26 @@
33: $self;
34: }
35:
36: +
37: +package RRDs::shell;
38: +@RRDs::shell::ISA = qw(RRDs::log);
39: +
40: +use strict;
41: +use Data::Dumper;
42: +
43: +sub new {
44: + my $proto = shift;
45: + my $self = (ref($proto) ? $proto : bless {}, $proto);
46: + if ( defined $self->{daemonize} ) {
47: + chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
48: + }
49: + $self;
50: +}
51: +
52: +# sub DESTROY {
53: +# my $self = shift;
54: +# }
55: +
56: sub sighup {
57: my $self = shift;
58: print STDERR "got [$$]: sighup\n" unless defined $self->{daemonize};
Posted by Manabu Higashida at 11:40 AM
| Comments (0)
September 12, 2003
モジュールの細分化
RRDs::rrdパッケージにちょこまかと変更を加えていると、 デーモン化して動作しているプロセスにその変更を適用したいときに、 プロセスの終了・再起動をいちいち行うのがちょっと面倒になってきました。 また、グラフ化処理は、RRDs:rrdパッケージに変更を行ってすぐ動作確認をしたいのですが、 ちんたら次のアップデート時間まで最長15分待つのも鬱陶しいです。 その処理を行うスクリプトを別途作ることは簡単ですが、 パッケージへの修正をいちいち反映させてそのスクリプトを保守するのもやはり鬱陶しいです。
という鬱陶しさを回避するため、 パッケージの再ロードと、デーモンに対するシグナリングで適宜グラフ化処理を呼び出せるように 修正を加えてみましょう。 まず、パッケージの再ロードは、
my $fh = FileHandle->new($INC{$file});
local($/);
eval <$fh>;
warn $@ if $@;
のようにすれば可能です。
ただし、実行中の関数を含むパッケージを再ロードすると動作が不安定になることがあるので
(経験則ですが)、
修正を加えた必要部分だけを再ロードするように、
モジュールを色分けして細分化した方が良いでしょう。
まずは、その色分け作業をしましょう。
RRDs::rrdをRRD操作に関する部分とそれ以外のデーモン化などの実行制御に関する部分に
振り分けて、RRDs::shellというパッケージを作りました。
RRDs::rrdへの具体的な変更は次の通りです。 まず、コンストラクタを二つに分け、それぞれのパッケージに振り分けます。 インスタンスを各々のパッケージのコンストラクタで初期化してしまうと、 インスタンス変数がどっちつかずになってしまいますので、 10行目の初期化を取り除いて、 既存のインスタンスの再初期化コンテキストを判断して、 再初期化の場合は、インスタンス引数を追加するようにします:
1: --- rrd.pm 2003/09/12 06:27:39 4.2
2: +++ rrd.pm 2003/09/14 02:11:58 5.1
3: @@ -15,9 +15,8 @@
4:
5: sub new {
6: my $proto = shift;
7: - my $class = ref($proto) || $proto;
8: + my $self = (ref($proto) ? $proto : bless {}, $proto);
9: my %params = @_;
10: - my $self = {};
11: $self->{debug} = $params{debug};
12: $self->{dryrun} = $params{dryrun} || $self->{debug} ;
13: $self->{daemonize} = ( defined $self->{debug} ? undef : $params{daemonize});
14: @@ -30,15 +29,6 @@
15: }
16: $self->{rrd} = "rrd/$self->{basename}.rrd";
17: $self->{img} = "img/$self->{basename}";
18: - $self->{rbuf_max} = 10;
19: - $self->{rbuf} = ();
20: - $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
21: - bless $self, $class;
22: - if ( defined $self->{daemonize} ) {
23: - eval { use Sys::Syslog; };
24: - chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
25: - openlog("$self->{basename}", "pid", "user");
26: - }
27: $self;
28: }
29:
30: @@ -305,6 +295,30 @@
31: }
32: }
33:
34: +package RRDs::shell;
35: +
36: +use strict;
37: +use Carp;
38: +use Data::Dumper;
39: +
40: +sub new {
41: + my $proto = shift;
42: + my $self = (ref($proto) ? $proto : bless {}, $proto);
43: + $self->{rbuf_max} = 10;
44: + $self->{rbuf} = ();
45: + $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
46: + if ( defined $self->{daemonize} ) {
47: + eval { use Sys::Syslog; };
48: + chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
49: + openlog("$self->{basename}", "pid", "user");
50: + }
51: + $self;
52: +}
53: +
54: +# sub DESTROY {
55: +# my $self = shift;
56: +# }
57: +
58: sub log {
59: my $self = shift;
60: my $fmt = shift;
Perlのコンストラクタ・デストラクタは、 複数の親クラスを継承したクラスのインスタンス生成・消滅時に 自動的に親クラスのコンストラクタ・デストラクタを呼び出しません。 ですから呼び出し側のスクリプトは、 次のように、@ISA変数に積まれている親クラスのコンストラクタ・デストラクタを 明示的に順繰り呼び出すように変更する必要があります。 これはDamian ConwayのOOP本に記載されたアイデアを元にコーディングしました:
1: --- temp.pl 2003/09/12 09:15:17 4.2
2: +++ temp.pl 2003/09/14 02:11:18 5.1
3: @@ -5,20 +5,24 @@
4: package RRDs::temp;
5:
6: use RRDs::rrd;
7: -@ISA = qw(RRDs::rrd);
8: +@ISA = qw(RRDs::rrd RRDs::shell);
9:
10: sub new {
11: my $proto = shift;
12: - my $class = ref($proto) || $proto;
13: - my $self = $class->SUPER::new(@_);
14: + my $self = (ref($proto) ? $proto : bless {}, $proto);
15: + $self->$_(@_) for ( map { $_->can("new") || () } @ISA );
16: $self->{host} = $ARGV[0] || 'localhost';
17: $self->{pass} = '';
18: $self->{community} = 'public';
19: $self->{objid} = '.1.3.6.1.4.1.674.10892.1.700.20.1.6';
20: - bless $self, $class;
21: $self;
22: }
23:
24: +sub DESTROY {
25: + my $self = shift;
26: + $self->$_() for ( map { $_->can("DESTROY") || () } @ISA );
27: +}
28: +
29: # RRDs::create unless exists rrd
30: sub create {
31: my $self = shift;
Posted by Manabu Higashida at 03:42 PM
| Comments (0)
September 11, 2003
GMT-centric対応モジュール
最終的に、RRDs::rrdパッケージでGMT-centric
問題に対応してみました。
インスタンス生成時にtz => 'JST-9'
のように引数を渡すことで、
ライブラリ内でタイムゾーンのオフセットを行わないようにすることと、
スクリプト内でUTCにオフセットした値をRRDToolの引数に渡すように
ちょこまかと修正を加えています。
まず、15-20行目のように、POSIXのtzset()を呼び出して
ライブラリ内でのタイムゾーン・オフセットを0に指定し、
表示に際してだけJST
を拾うように設定します。
28行目は、RRDs::update()する際の引数を
GMT-centric
な合算処理に適合するようにオフセットしています。
33行目以降はRRDs::graph()呼び出しに際して必要となるオフセット指定です。
RRDs::graph()は明示的に-eオプションを指定しないと、
現在時刻を拾って、そこを終点にグラフ化処理を行いますが、
現在時刻をオフセットすることなく使われてしまうと、9時間前が終点になって表示されてしまいます。
これを勘案して、
必ず-eオプションで現在時刻から必要なオフセットを込めて指定するようにしています:
1: --- rrd.pm 2003/09/12 06:06:55 4.1.1.1
2: +++ rrd.pm 2003/09/12 06:27:39 4.2
3: @@ -8,6 +8,7 @@
4: use Carp;
5: use Data::Dumper;
6: use Time::HiRes qw(time);
7: +use POSIX;
8:
9: unshift(@INC, '/usr/local/rrdtool/lib/perl');
10: require 'RRDs.pm';
11: @@ -21,6 +22,12 @@
12: $self->{dryrun} = $params{dryrun} || $self->{debug} ;
13: $self->{daemonize} = ( defined $self->{debug} ? undef : $params{daemonize});
14: $self->{basename} = $params{basename};
15: + if ( $params{tz} =~ /^([A-Z]+)([+-]*\d+)$/ ) {
16: + $self->{tz_std} = $1;
17: + $self->{tz_offset} = $2;
18: + $ENV{TZ} = "$self->{tz_std}"; # set tz without tz_offset
19: + POSIX::tzset();
20: + }
21: $self->{rrd} = "rrd/$self->{basename}.rrd";
22: $self->{img} = "img/$self->{basename}";
23: $self->{rbuf_max} = 10;
24: @@ -71,6 +78,7 @@
25: my $v = shift;
26: my $rrd = $self->{rrd};
27:
28: + $t -= $self->{tz_offset}*60*60 if defined $self->{tz_offset};
29: $self->log("update at %.5f with %s", time(), "$t:$v") unless defined $self->{dryrun};
30: RRDs::update($rrd, "$t:$v") unless defined $self->{dryrun};
31: my $e = RRDs::error();
32: @@ -85,32 +93,41 @@
33: sub graph {
34: my $self = shift;
35: my $img = $self->{img};
36: + my @rra_params = $self->rra_params();
37: +
38: + my $now = int time() - $self->{tz_offset}*60*60;
39: + my $end = sub {
40: + my $i = shift;
41: + my($pdp_per_row,$rows) = @{$rra_params[$i]};
42: + my $res = $self->{step}*$pdp_per_row;
43: + int($now/$res)*$res;
44: + };
45:
46: - RRDs::graph("$img-day.gif", '-s', '-1d', @_) unless defined $self->{dryrun};
47: + RRDs::graph("$img-day.gif", '-e', &$end(2), '-s', 'e-1d', @_) unless defined $self->{
dryrun};
48: my $e = RRDs::error();
49: if ( $e ) {
50: - $self->log("'Cannot generate graph: %s", $e);
51: + $self->log("Cannot generate daily graph: %s", $e);
52: return 1;
53: }
54:
55: - RRDs::graph("$img-week.gif", '-s', '-1w', @_) unless defined $self->{dryrun};
56: + RRDs::graph("$img-week.gif", '-e', &$end(1), '-s', 'e-1w', @_) unless defined $self->
{dryrun};
57: my $e = RRDs::error();
58: if ( $e ) {
59: - $self->log("'Cannot generate graph: %s", $e);
60: + $self->log("Cannot generate weekly graph: %s", $e);
61: return 1;
62: }
63:
64: - RRDs::graph("$img-month.gif", '-s', '-1m', @_) unless defined $self->{dryrun};
65: + RRDs::graph("$img-month.gif", '-e', &$end(0), '-s', 'e-1month', @_) unless defined $s
elf->{dryrun};
66: my $e = RRDs::error();
67: if ( $e ) {
68: - $self->log("'Cannot generate graph: %s", $e);
69: + $self->log("Cannot generate monthly graph: %s", $e);
70: return 1;
71: }
72:
73: - RRDs::graph("$img-year.gif", '-s', '-13month', @_) unless defined $self->{dryrun};
74: + RRDs::graph("$img-year.gif", '-e', &$end(0), '-s', 'e-13month', @_) unless defined $s
elf->{dryrun};
75: my $e = RRDs::error();
76: if ( $e ) {
77: - $self->log("'Cannot generate graph: %s", $e);
78: + $self->log("Cannot generate yearly graph: %s", $e);
79: return 1;
80: }
81: return 0;
呼び出し側のスクリプトは、RRDs::rrdの仕様変更に伴う修正です。 RRDs::rrd::update()は、オフセット処理を行いやすいように、二つ引数を採るようにしたので、 それに伴う変更を行っています:
1: --- temp.pl 2003/09/11 04:46:55 2.8
2: +++ temp.pl 2003/09/12 09:15:17 4.2
3: @@ -50,16 +50,17 @@
4: my $community = $self->{community};
5: my $objid = $self->{objid};
6:
7: - my $x = int time();
8: + my $t = int time();
9: + my @v = ();
10: open(INPUT, "snmpbulkwalk -v2c -c $community $host $objid |");
11: while (<INPUT>) {
12: chomp;
13: if ( /= INTEGER:\s+([0-9]+)\s*$/ ) {
14: - $x = sprintf "%s:%.1f", $x, $1/10.0;
15: + push @v, sprintf "%.1f", $1/10.0;
16: }
17: }
18: close INPUT;
19: - return $self->SUPER::update($x);
20: + return $self->SUPER::update($t, join(':', @v));
21: }
22:
23: # RRDs::graph
24: @@ -104,7 +105,7 @@
25: inline_states =>
26: {
27: _start => sub {
28: - my $rrd = RRDs::temp->new( basename => 'temp', debug => $opt_d, daemonize => !$o
pt_d );
29: + my $rrd = RRDs::temp->new( basename => 'temp', debug => $opt_d, daemonize => !$o
pt_d, tz => 'JST-9', );
30: $rrd->load_info();
31: my $crontab = $rrd->step2crontab();
32: print STDERR $crontab, "\n" if defined $opt_d;
これで一通り必要な修正は完了しました。 とにかくRRDからデータをフェッチする際にオフセットが必要なことさえ忘れなければ、 これで問題ないようですね。
Posted by Manabu Higashida at 03:35 PM
| Comments (0)
September 10, 2003
GMT-centric問題解決のための一歩
RRDはUnix Epochからの経過秒を基準に様々な処理を行っていますので
GMT-centric
問題が生じるのですが、
それを逆手に取れば、データを登録する際に (JSTでは) 9時間進めた時刻で登録することにより
この問題も概ね解決してしまいます (後々そのことを覚えてないと大混乱しますけど...)。
ただし、余計なお節介なことに、グラフ化の際にタイムゾーンを参照して目盛りを振っています。
その部分は次のように騙さなくてはなりません。オフセットを指定しないところがミソです:
1: --- temp-convert.pl 2003/09/10 14:39:08 1.3.1.1
2: +++ temp-convert.pl 2003/09/10 14:36:53 1.4
3: @@ -16,13 +16,17 @@
4: my $rrd2 = RRDs::rrd->new( basename => 'temp-new', dryrun => undef, );
5: $rrd2->create(@args) unless $dbg;
6: my $cb = sub {
7: - $rrd2->update("$_[0]:$_[1]") if ( $_[0] > $rrd2->{last_update} );
8: + my $t = $_[0]+9*60*60;
9: + $rrd2->update("$t:$_[1]") if ( $_[0] > $rrd2->{last_update} );
10: };
11: $rrd2->load_info() unless $dbg;
12: $rrd0->fetch( cb => $cb, sf => 0.5 ) unless $dbg;
13: $rrd2->load_info() unless $dbg;
14: $rrd ->fetch( cb => $cb, sf => 0.5 ) unless $dbg;
15: {
16: + eval { use POSIX; };
17: + $ENV{TZ} = 'JST';
18: + POSIX::tzset();
19: my $host = $rrd2->{host};
20: my $rrd = $rrd2->{rrd};
21: my @args = (
あとは、fetch()する際に指定する時刻などもすべて9時間進めて指定すればいいはずです。 追い追い注意しながら検証していきましょうか...。
Posted by Manabu Higashida at 11:59 PM
| Comments (0)
September 09, 2003
重複期間の排他処理
RRDToolのGMT-centric
問題に手を付ける前に、
前回の仕事は、さすがにやっつけ仕事だけあって、
二つのRRDをマージする際にオーバーラップした部分を考慮せず、
重複を厭わず強引にupdateしてRRDToolのエラー処理に委ねていました。
ですから、途中で次のようなエラーが山のように出ていたのです:
Cannot update rrd/temp-new.rrd with 1042892100:::::: illegal attempt to update using tim
ちょっと考えてみたら、モジュールを変更せずに、 呼び出し側のスクリプティングで簡単に直るので次のように処置しました:
1: --- temp-convert.pl 2003/09/10 09:47:32 1.2
2: +++ temp-convert.pl 2003/09/10 14:07:43 1.3
3: @@ -14,8 +14,13 @@
4: {
5: my $rrd2 = RRDs::rrd->new( basename => 'temp-new', dryrun => undef, );
6: $rrd2->create(@args);
7: - $rrd0->fetch( cb => sub { $rrd2->update($_[0]) }, sf => 0.5 );
8: - $rrd ->fetch( cb => sub { $rrd2->update($_[0]) }, sf => 0.5 );
9: + my $cb = sub {
10: + $rrd2->update("$_[0]:$_[1]") if ( $_[0] > $rrd2->{last_update} );
11: + };
12: + $rrd2->load_info();
13: + $rrd0->fetch( cb => $cb, sf => 0.5 );
14: + $rrd2->load_info();
15: + $rrd ->fetch( cb => $cb, sf => 0.5 );
16: {
17: my $host = $rrd2->{host};
18: my $rrd = $rrd2->{rrd};
Posted by Manabu Higashida at 09:35 PM
| Comments (0)
September 08, 2003
前年同月比
この暑さを実感するために、昨年の同月との比較をしたくなりました:-P 諸般の事情があり、サーバーの環境温度測定は今年の1月中旬に頓挫しておりましたので、 前年同月比を出そうとすると以前のRRDと今採っているRRDをマージする必要があります (グラフ化するだけなら、複数のRRDのソースを参照できるのでその必要はありませんが...)。 こういうのは力業ですね。次のようにえいやっとやっつけてしまいました:
1: --- temp-convert.pl 2003/09/07 10:02:15 1.1
2: +++ temp-convert.pl 2003/09/10 09:47:32 1.2
3: @@ -5,6 +5,7 @@
4: use Data::Dumper;
5:
6: {
7: + my $rrd0 = RRDs::rrd->new( basename => 'temp-20030118', dryrun => 1, );
8: my $rrd = RRDs::rrd->new( basename => 'temp-20030907', dryrun => 1, );
9: $rrd->load_info();
10: # print Data::Dumper->Dump([$rrd],[qw(rrd)]);
11: @@ -13,7 +14,8 @@
12: {
13: my $rrd2 = RRDs::rrd->new( basename => 'temp-new', dryrun => undef, );
14: $rrd2->create(@args);
15: - $rrd->fetch( cb => sub { $rrd2->update($_[0]) } );
16: + $rrd0->fetch( cb => sub { $rrd2->update($_[0]) }, sf => 0.5 );
17: + $rrd ->fetch( cb => sub { $rrd2->update($_[0]) }, sf => 0.5 );
18: {
19: my $host = $rrd2->{host};
20: my $rrd = $rrd2->{rrd};
ただし、RRDs::rrdも次のようにちょこちょこ変更する必要がありました:
1: --- rrd.pm 2003/09/07 10:00:35 3.11.1.2
2: +++ rrd.pm 2003/09/10 09:42:02 3.11.1.3
3: @@ -106,7 +106,7 @@
4: return 1;
5: }
6:
7: - RRDs::graph("$img-year.gif", '-s', '-1y', @_) unless defined $self->{dryrun};
8: + RRDs::graph("$img-year.gif", '-s', '-13month', @_) unless defined $self->{dryrun};
9: my $e = RRDs::error();
10: if ( $e ) {
11: $self->log("'Cannot generate graph: %s", $e);
12: @@ -184,7 +184,12 @@
13: sub rra_params {
14: my $self = shift;
15: my @args = ();
16: - for my $k ( sort keys %{$self->{rra}} ) {
17: + my @kref = keys %{$self->{rra}};
18: + if ( $#kref < 0 ) {
19: + $self->load_info();
20: + @kref = keys %{$self->{rra}};
21: + }
22: + for my $k ( sort @kref ) {
23: my $rra = \%{$self->{rra}{$k}};
24: # printf "RRA:%s:%.2f:%d:%d\n",
25: # $rra->{cf}, $rra->{xff}, $rra->{pdp_per_row}, $rra->{rows};
26: @@ -197,21 +202,22 @@
27: sub fetch {
28: my $self = shift;
29: my %params = @_;
30: + my @rra_params = $self->rra_params();
31: + my $sf = $params{sf} || 1.0; # scaling factor
32: my $filename = $self->{rrd};
33: my $old_step = $self->{step};
34: - my $new_step = int($old_step/2);
35: - my @rra_params = $self->rra_params();
36: + my $new_step = int($old_step*$sf);
37: my %fetch;
38:
39: # print Data::Dumper->Dump([\@rra_params],[qw(*rra_params)]);
40:
41: - my $now = int time();
42: + my $last_update = $self->{last_update};
43: my $interval = sub {
44: my $i = shift;
45: if ( $i <= $#rra_params ) {
46: my($pdp_per_row,$rows) = @{$rra_params[$i]};
47: my $res = $old_step*$pdp_per_row;
48: - my $e = int($now/$res)*$res;
49: + my $e = int($last_update/$res)*$res;
50: my $s = $res*($rows-1);
51: ($e-$s,$e);
52: } else {
7-8行目の変更は、前年同月までをグラフ化するための変更です。 16-22行目と35行目を31行目に移したのは、RRDs::rrd::fetch()する以前に どこかでRRDs::rrd::load_info()する必要があるからです。 スケーリングファクタが固定だったので引数で指定できるようにしました (31,34-35行目)。 あとは、RRDの最終レコードの拾い方がおかしかったので、 RRDファイルのlast_updateレコードを参照するようにしました。
というわけで、今年の9月はやはり熱いです！
Posted by Manabu Higashida at 09:35 PM
| Comments (0)
September 07, 2003
ようやく...
最終的に次のようなスクリプティングで、 既存のRRDファイルの再サンプリングができるようになりました:
1: #!/usr/bin/perl
2: # $Id: temp-convert.pl,v 1.1 2003/09/07 10:02:15 manabu Exp $
3:
4: use RRDs::rrd;
5: use Data::Dumper;
6:
7: {
8: my $rrd = RRDs::rrd->new( basename => 'temp-20030907', dryrun => 1, );
9: $rrd->load_info();
10: # print Data::Dumper->Dump([$rrd],[qw(rrd)]);
11: my @args = $rrd->restore_args(0.5);
12: # print Data::Dumper->Dump([\@args],[qw(*args)]);
13: {
14: my $rrd2 = RRDs::rrd->new( basename => 'temp-new', dryrun => undef, );
15: $rrd2->create(@args);
16: $rrd->fetch( cb => sub { $rrd2->update($_[0]) } );
17: {
18: my $host = $rrd2->{host};
19: my $rrd = $rrd2->{rrd};
20: my @args = (
21: '--title', "$host",
22: '-v', 'Degree',
23: '--upper-limit', '70',
24: '--lower-limit', '10',
25: "DEF:t1=$rrd:t1:AVERAGE", 'LINE1:t1#FFA500:CPU1',
26: "DEF:t2=$rrd:t2:AVERAGE", 'LINE1:t2#FF4500:CPU2',
27: "DEF:t3=$rrd:t3:AVERAGE", 'LINE2:t3#00FF00:MotherBoard',
28: "DEF:t4=$rrd:t4:AVERAGE", 'LINE1:t4#00A5FF:BackPlane1',
29: "DEF:t5=$rrd:t5:AVERAGE", 'LINE1:t5#0045FF:BackPlane2',
30: );
31: $rrd2->graph(@args);
32: }
33: }
34: }
11行目で、既存のRRDファイルから生成時の引数をリストアする際に、 スケール・ファクタを指定してサンプリング間隔を半分にしています。 さらに、16行目で、既存のRRDファイルから登録データをフェッチして表示する際に、 コールバック関数を渡して表示の代わりにそれを使うように指示しています。 コールバック関数は、 新しく生成したRRDファイルに次々と値を登録するようにコーディングしてあります。
こうやって眺めると、20-30行目のgraph()関数に渡すオプションの記述が冗長に見えますが、 RRDファイルにはこれらの指定を格納する場所がありませんので、 とりあず現状ではどうしようもありませんね...。
Posted by Manabu Higashida at 07:24 PM
| Comments (0)
September 06, 2003
errata
最終的に作業していたらバグが結構ありました:-P
まず、一番根本的なのは、crontabの/
の意味の取り違えです。
わたしは、１時間に何回とか、一日に何回かとか勘違いしていましたが、
あれは、何分おきとか、何時間おきという意味だったのですね...。
1: --- rrd.pm 2003/09/04 08:54:47 3.4.1.3
2: +++ rrd.pm 2003/09/07 08:38:02 3.4.1.4
3: @@ -159,13 +159,13 @@
4: switch ( sub { $_[0] > $step } ) {
5: case 3600 {
6: croak "not a factor of 60: $m minutes" if 60 % $m;
7: - return sprintf("*\/%d * * * *", &$divide(60,$m));
8: + return sprintf("*\/%d * * * *", $m);
9: }
10: case 86400 {
11: croak "too fractional: $step" if $m % 60;
12: my $h = int(&$divide($step,60*60));
13: croak "not a factor of 24: $h hours" if 24 % $h;
14: - return sprintf ("0 *\/%d * * *", &$divide(24,$h))
15: + return sprintf ("0 *\/%d * * *", $h)
16: }
17: }
18: }
それから、デバッグ・オプション-d
を指定したときの
振る舞いを次のようにしました
(デバッグ・オプション指定時はdryrunでdaemonizeしない)。
Weblogのタイトルはそのつもりで付けたのですが、コードが伴っていませんでした:-P
1: --- rrd.pm 2003/09/04 10:14:27 3.10
2: +++ rrd.pm 2003/09/07 09:09:08 3.10.2.1
3: @@ -17,9 +17,9 @@
4: my $class = ref($proto) || $proto;
5: my %params = @_;
6: my $self = {};
7: - $self->{dryrun} = $params{dryrun};
8: - $self->{daemonize} = $params{daemonize};
9: $self->{debug} = $params{debug};
10: + $self->{dryrun} = $params{dryrun} || $self->{debug} ;
11: + $self->{daemonize} = $params{daemonize} && !($self->{debug});
12: $self->{basename} = $params{basename};
13: $self->{rrd} = "rrd/$self->{basename}.rrd";
14: $self->{img} = "img/$self->{basename}";
あと、rrdtool create
に渡すオプションにファイル名が抜けていたのと、
--startオプションで開始時刻を明示的に指定しないと、
RRDファイルを作成したときが最終更新時刻に設定されてしまい、
過去に遡ったデータの登録が出来ません
(通常その必要はないのですが、今回は再サンプリングしたいので必要です)。
ここはRRDのエポック (すなわちUnix Epoch) である1970/01/01 0:0:0 UTC
、
すなわち0を指定すればよさそうですが、実際は、その10年後の
1980/01/01 0:0:0 UTC
よりも小さな経過秒を指定すると、
パーザが無理矢理MMDDYY
に当てはめて解釈しようとするので、
うまくいきません。ここは次のように指定するのが無難でしょう。
1: --- rrd.pm 2003/09/07 08:44:45 3.10.1.1
2: +++ rrd.pm 2003/09/07 08:49:29 3.10.1.2
3: @@ -50,7 +50,11 @@
4: my $self = shift;
5: my $rrd = $self->{rrd};
6: unless ( -e $rrd ) {
7: - RRDs::create(@_) unless defined $self->{dryrun};
8: + $self->log("Create rrd: %s with %s", $rrd, Data::Dumper->Dump([\@_],[qw(*args)]))
9: + if defined $self->{dryrun};
10: + eval { use Time::ParseDate; };
11: + my $rrd_epoch = parsedate('1980/01/01 UTC');
12: + RRDs::create($rrd, '--start', $rrd_epoch, @_) unless defined $self->{dryrun};
13: my $e = RRDs::error();
14: if ( $e ) {
15: $self->log("Cannot create rrd: %s", $e);
Posted by Manabu Higashida at 09:35 PM
| Comments (0)
September 05, 2003
debug = dry run - daemonize?
asp/rrd/rrd-info.aspから、 RRDファイルから生成時のオプションをリストアする関数を移植:
1: *** rrd.pm 2003/09/04 09:44:32 3.8
2: --- rrd.pm 2003/09/04 09:58:44 3.9
3: ***************
4: *** 143,148 ****
5: --- 143,182 ----
6: $self;
7: }
8:
9: + sub restore_args {
10: + my $self = shift;
11: + my $sf = shift || 1.0; # scaling factor
12: + my @args = ();
13: + push @args, '--step', int($self->{step}*$sf);
14: + for my $k ( sort keys %{$self->{ds}} ) {
15: + my $ds = \%{$self->{ds}{$k}};
16: + push @args, sprintf("DS:%s:%s:%d:%d:%d",
17: + $k,
18: + $ds->{type},
19: + int($ds->{minimal_heartbeat}*$sf),
20: + $ds->{min},
21: + $ds->{max},
22: + );
23: + }
24: + for my $k ( sort keys %{$self->{rra}} ) {
25: + my $rra = \%{$self->{rra}{$k}};
26: + my($pdp_per_row,$rows) = ($rra->{pdp_per_row},$rra->{rows});
27: + if ( $rra->{pdp_per_row} == 1 ) {
28: + $rows = int($rows/$sf);
29: + } else {
30: + $pdp_per_row = int($pdp_per_row/$sf);
31: + }
32: + push @args, sprintf("RRA:%s:%.2f:%d:%d",
33: + $rra->{cf},
34: + $rra->{xff},
35: + $pdp_per_row,
36: + $rows,
37: + );
38: + }
39: +
40: + return @args;
41: + }
42: +
43: sub rra_params {
44: my $self = shift;
45: my @args = ();
あとは、試行錯誤をやりやすくするために、 デバッグ実行指定に、デーモン化やドライ・ラン指定をごちゃ混ぜに詰め込んであったのを分離:
1: --- rrd.pm 2003/09/04 09:58:44 3.9
2: +++ rrd.pm 2003/09/04 10:14:27 3.10
3: @@ -17,6 +17,8 @@
4: my $class = ref($proto) || $proto;
5: my %params = @_;
6: my $self = {};
7: + $self->{dryrun} = $params{dryrun};
8: + $self->{daemonize} = $params{daemonize};
9: $self->{debug} = $params{debug};
10: $self->{basename} = $params{basename};
11: $self->{rrd} = "rrd/$self->{basename}.rrd";
12: @@ -25,7 +27,7 @@
13: $self->{rbuf} = ();
14: $#{$self->{rbuf}} = $self->{rbuf_max} - 1;
15: bless $self, $class;
16: - unless ( defined $self->{debug} ) {
17: + if ( defined $self->{daemonize} ) {
18: eval { use Sys::Syslog; };
19: chdir('/var/www/html/higashida.net/manabu/qhr/asp/rrd');
20: openlog("$self->{basename}", "pid", "user");
21: @@ -35,7 +37,7 @@
22:
23: sub DESTROY {
24: my $self = shift;
25: - unless ( defined $self->{debug} ) {
26: + if ( defined $self->{daemonize} ) {
27: closelog();
28: } else {
29: printf STDERR "$self has destructed.\n";
30: @@ -48,7 +50,7 @@
31: my $self = shift;
32: my $rrd = $self->{rrd};
33: unless ( -e $rrd ) {
34: - RRDs::create(@_) unless defined $self->{debug};
35: + RRDs::create(@_) unless defined $self->{dryrun};
36: my $e = RRDs::error();
37: if ( $e ) {
38: $self->log("Cannot create rrd: %s", $e);
39: @@ -65,7 +67,7 @@
40: my $rrd = $self->{rrd};
41:
42: $self->log("update at %.5f with %s", time(), $x);
43: - RRDs::update($rrd, $x) unless defined $self->{debug};
44: + RRDs::update($rrd, $x) unless defined $self->{dryrun};
45: my $e = RRDs::error();
46: if ( $e ) {
47: $self->log("Cannot update %s with %s: %s", $rrd, $x, $e);
48: @@ -81,28 +83,28 @@
49: my $rrd = $self->{rrd};
50: my $img = $self->{img};
51:
52: - RRDs::graph("$img-day.gif", '-s', '-1d', @_) unless defined $self->{debug};
53: + RRDs::graph("$img-day.gif", '-s', '-1d', @_) unless defined $self->{dryrun};
54: my $e = RRDs::error();
55: if ( $e ) {
56: syslog('info', 'Cannot generate graph: %s', $e);
57: return 1;
58: }
59:
60: - RRDs::graph("$img-week.gif", '-s', '-1w', @_) unless defined $self->{debug};
61: + RRDs::graph("$img-week.gif", '-s', '-1w', @_) unless defined $self->{dryrun};
62: my $e = RRDs::error();
63: if ( $e ) {
64: syslog('info', 'Cannot generate graph: %s', $e);
65: return 1;
66: }
67:
68: - RRDs::graph("$img-month.gif", '-s', '-1m', @_) unless defined $self->{debug};
69: + RRDs::graph("$img-month.gif", '-s', '-1m', @_) unless defined $self->{dryrun};
70: my $e = RRDs::error();
71: if ( $e ) {
72: syslog('info', 'Cannot generate graph: %s', $e);
73: return 1;
74: }
75:
76: - RRDs::graph("$img-year.gif", '-s', '-1y', @_) unless defined $self->{debug};
77: + RRDs::graph("$img-year.gif", '-s', '-1y', @_) unless defined $self->{dryrun};
78: my $e = RRDs::error();
79: if ( $e ) {
80: syslog('info', 'Cannot generate graph: %s', $e);
81: @@ -280,11 +282,11 @@
82: sub log {
83: my $self = shift;
84: my $fmt = shift;
85: - if ( defined $self->{debug} ) {
86: + if ( defined $self->{daemonize} ) {
87: + syslog("info", sprintf($fmt, @_));
88: + } else {
89: printf STDERR $fmt, @_;
90: print STDERR "\n";
91: - } else {
92: - syslog("info", sprintf($fmt, @_));
93: }
94: pop @{$self->{rbuf}};
95: unshift @{$self->{rbuf}}, sprintf($fmt, @_);
96: @@ -293,13 +295,13 @@
97:
98: sub sighup {
99: my $self = shift;
100: - print STDERR "got [$$]: sighup\n" if defined $self->{debug};
101: + print STDERR "got [$$]: sighup\n" if defined $self->{daemonize};
102: $self;
103: }
104:
105: sub sigint {
106: my $self = shift;
107: - print STDERR "got [$$]: sigint\n" if defined $self->{debug};
108: + print STDERR "got [$$]: sigint\n" if defined $self->{daemonize};
109: {
110: my $tmp = "/tmp/cron-temp.$$";
111: open(DUMP, ">$tmp");
112: @@ -313,7 +315,7 @@
113:
114: sub sigterm {
115: my $self = shift;
116: - print STDERR "got [$$]: sigterm\n" if defined $self->{debug};
117: + print STDERR "got [$$]: sigterm\n" if defined $self->{daemonize};
118: $self;
119: }
120:
さて、これで既存のRRDファイルの更新間隔ステップ秒を 再調整するスクリプトを記述する準備が整いました。結構長かったですね...。
Posted by Manabu Higashida at 10:29 PM
| Comments (0)
September 04, 2003
simplification for ease of understanding
以前作成したasp/rrd/rrd-fetch.plをRRDs::rrdに埋め込んでみました。 RRAのパラメータをRRDから拾うRRDs::rrd::rra_params()をついでに作成しています:
1: --- rrd.pm 2003/09/03 13:29:21 3.4.1.2
2: +++ rrd.pm 2003/09/04 05:28:10 3.5
3: @@ -143,6 +143,68 @@
4: $self;
5: }
6:
7: +sub rra_params {
8: + my $self = shift;
9: + my @args = ();
10: + for my $k ( sort keys %{$self->{rra}} ) {
11: + my $rra = \%{$self->{rra}{$k}};
12: + # printf "RRA:%s:%.2f:%d:%d\n",
13: + # $rra->{cf}, $rra->{xff}, $rra->{pdp_per_row}, $rra->{rows};
14: + unshift @args, [$rra->{pdp_per_row}, $rra->{rows}]
15: + if ( $rra->{cf} =~ /AVERAGE/ );
16: + }
17: + @args;
18: +}
19: +
20: +sub fetch {
21: + my $self = shift;
22: + my $filename = $self->{rrd};
23: + my $old_step = $self->{step};
24: + my $new_step = int($old_step/2);
25: + my @rra_params = $self->rra_params();
26: + my %fetch;
27: +
28: +# print Data::Dumper->Dump([\@rra_params],[qw(*rra_params)]);
29: +
30: + for my $i (0..$#rra_params) {
31: + my($pdp_per_row,$rows) = @{$rra_params[$i]};
32: + my $res = $old_step*$pdp_per_row;
33: + my $e = int(time()/$res)*$res;
34: + my $s = $res*($rows-1);
35: + my @args = (
36: + 'AVERAGE',
37: + '-e', "$e",
38: + '-s', "e-$s",
39: + );
40: + # print Data::Dumper->Dump([\@args],[qw(*args)]);
41: +
42: + ($fetch{$i}{start},$fetch{$i}{step},$fetch{$i}{names},$fetch{$i}{data})
43: + = RRDs::fetch($filename,@args);
44: + }
45: +
46: + for my $i (0..$#rra_params) {
47: + my $next_start = $fetch{$i+1}{start};
48: + my $start = $fetch{$i}{start};
49: + my $step = $fetch{$i}{step};
50: + my $data = $fetch{$i}{data};
51: + print "\$start = ", $start, " (", scalar localtime($start), ")\n";
52: + print "\$step = ", $step, "\n";
53: + {
54: + my $t1 = $start;
55: + SKIP:
56: + foreach my $line (@$data) {
57: + # print "(", scalar localtime($t1), ")\n";
58: + my $out = join(':', @$line);
59: + for(my $t2 = $t1; $t2 < $t1+$step; $t2+=$new_step) {
60: + last SKIP if ( $next_start && $t2 >= $next_start );
61: + print "$t2:$out\n";
62: + }
63: + $t1+=$step;
64: + }
65: + }
66: + }
67: +}
68: +
69: sub step2crontab {
70: my $self = shift;
71: my $step = shift || $self->{step} || 1800;
このようなモジュール化 (ライブラリ化) の最大の利点は、 再利用に配慮して手を加える気力が湧いてくることでしょう。 将来を見越してちょっと弄ってみると、少しずついい知恵が湧いてくるもので、 すべてのRRAをごっそり読み込む殿様プログラミング (でしたね〜:-P) は辞めて、 早速次のようにコーディングの簡明さ、美しさに走るわたしでした。 やはり簡明なコーディングの方が理解もしやすいでしょう。 潤沢な資源といっても浪費はなりません:-)
1: *** rrd.pm 2003/09/04 05:28:10 3.5
2: --- rrd.pm 2003/09/04 08:36:04 3.6
3: ***************
4: *** 166,193 ****
5:
6: # print Data::Dumper->Dump([\@rra_params],[qw(*rra_params)]);
7:
8: ! for my $i (0..$#rra_params) {
9: my($pdp_per_row,$rows) = @{$rra_params[$i]};
10: my $res = $old_step*$pdp_per_row;
11: ! my $e = int(time()/$res)*$res;
12: my $s = $res*($rows-1);
13: my @args = (
14: 'AVERAGE',
15: '-e', "$e",
16: - '-s', "e-$s",
17: );
18: # print Data::Dumper->Dump([\@args],[qw(*args)]);
19: !
20: ! ($fetch{$i}{start},$fetch{$i}{step},$fetch{$i}{names},$fetch{$i}{data})
21: ! = RRDs::fetch($filename,@args);
22: ! }
23: !
24: ! for my $i (0..$#rra_params) {
25: ! my $next_start = $fetch{$i+1}{start};
26: ! my $start = $fetch{$i}{start};
27: ! my $step = $fetch{$i}{step};
28: ! my $data = $fetch{$i}{data};
29: print "\$start = ", $start, " (", scalar localtime($start), ")\n";
30: print "\$step = ", $step, "\n";
31: {
32: my $t1 = $start;
33: --- 166,197 ----
34:
35: # print Data::Dumper->Dump([\@rra_params],[qw(*rra_params)]);
36:
37: ! my $now = int time();
38: ! my $interval = sub {
39: ! my $i = shift;
40: ! if ( $i <= $#rra_params ) {
41: my($pdp_per_row,$rows) = @{$rra_params[$i]};
42: my $res = $old_step*$pdp_per_row;
43: ! my $e = int($now/$res)*$res;
44: my $s = $res*($rows-1);
45: + ($e-$s,$e);
46: + } else {
47: + (undef,undef);
48: + }
49: + };
50: +
51: + for my $i (0..$#rra_params) {
52: + my($s,$e)=&$interval($i);
53: my @args = (
54: 'AVERAGE',
55: + '-s', "$s",
56: '-e', "$e",
57: );
58: # print Data::Dumper->Dump([\@args],[qw(*args)]);
59: ! my($start,$step,$names,$data) = RRDs::fetch($filename,@args);
60: ! my $next_start = (&$interval($i+1))[0];
61: print "\$start = ", $start, " (", scalar localtime($start), ")\n";
62: + print "\$next_start = ", $next_start, "\n";
63: print "\$step = ", $step, "\n";
64: {
65: my $t1 = $start;
このままではRRDs::fetch()したデータを再サンプリングして表示するだけですが、 さらに次のような変更を加え、コールバック関数を引数として渡すことによって、 RRDs::rrd::fetch()を呼び出した側から 再サンプリングしたデータを使った操作ができるような細工を施しました:
1: *** rrd.pm 2003/09/04 08:36:04 3.6
2: --- rrd.pm 2003/09/04 08:54:07 3.7
3: ***************
4: *** 158,163 ****
5: --- 158,164 ----
6:
7: sub fetch {
8: my $self = shift;
9: + my %params = @_;
10: my $filename = $self->{rrd};
11: my $old_step = $self->{step};
12: my $new_step = int($old_step/2);
13: ***************
14: *** 201,208 ****
15: --- 202,213 ----
16: my $out = join(':', @$line);
17: for(my $t2 = $t1; $t2 < $t1+$step; $t2+=$new_step) {
18: last SKIP if ( $next_start && $t2 >= $next_start );
19: + if ( ref $params{cb} eq 'CODE' ) {
20: + &{$params{cb}}("$t2:$out");
21: + } else {
22: print "$t2:$out\n";
23: }
24: + }
25: $t1+=$step;
26: }
27: }
使い方は後ほど...。
Posted by Manabu Higashida at 10:27 PM
| Comments (0)
September 03, 2003
Switch.pm
Damian ConwayによるSwitch.pm は、 Perlでswitch...case構文を利用可能にするモジュールです (Perl6ではようやくgiven...whenという キーワードで実装されるらしいですが...)。 caseで取りうる値は大抵のものが許容されているので一見便利そうですが、 割と無理矢理な実装のようで、パーザが非常にセンシティブです。 例題のような簡単なものは割と問題ないのですけど、 複雑なコーディングをしようとすると、 ひたすらパーザに気に入られるようにコーディングしないと動いてくれません:
1: *** rrd.pm 2003/09/03 09:29:14 3.2.1.1
2: --- rrd.pm 2003/09/04 08:54:47 3.4.1.3
3: ***************
4: *** 145,169 ****
5:
6: sub step2crontab {
7: my $self = shift;
8: ! my $step = $self->{step};
9: croak "out of range: $step" if ( $step < 60 || $step > 86400 );
10: ! if ( $step == 60 ) { # minutely
11: ! return "* * * * *";
12: ! } elsif ( $step == 3600 ) { # hourly
13: ! return "0 * * * *";
14: ! } elsif ( $step == 86400 ) { # daily
15: ! return "0 0 * * *";
16: ! } else {
17: croak "too fractional: $step" if $step % 60;
18: ! my $m = int($step/60);
19: ! if ( $step < 3600 ) {
20: croak "not a factor of 60: $m minutes" if 60 % $m;
21: ! return sprintf ("*/%d * * * *", 60/$m);
22: ! } elsif ( $step < 86400 ) {
23: croak "too fractional: $step" if $m % 60;
24: ! my $h = int($step/60/60);
25: croak "not a factor of 24: $h hours" if 24 % $h;
26: ! return sprintf ("0 */%d * * *", 24/$h);
27: }
28: }
29: }
30: --- 145,173 ----
31:
32: sub step2crontab {
33: my $self = shift;
34: ! my $step = shift || $self->{step} || 1800;
35: ! my $divide = sub { $_[0]/$_[1] };
36: croak "out of range: $step" if ( $step < 60 || $step > 86400 );
37: ! eval { use Switch; };
38: ! switch ( $step ) {
39: ! case 60 { return "* * * * *" } # minutely
40: ! case 3600 { return "0 * * * *" } # hourly
41: ! case 86400 { return "0 0 * * *" } # daily
42: ! else {
43: croak "too fractional: $step" if $step % 60;
44: ! my $m = int(&$divide($step,60));
45: ! switch ( sub { $_[0] > $step } ) {
46: ! case 3600 {
47: croak "not a factor of 60: $m minutes" if 60 % $m;
48: ! return sprintf("*\/%d * * * *", &$divide(60,$m));
49: ! }
50: ! case 86400 {
51: croak "too fractional: $step" if $m % 60;
52: ! my $h = int(&$divide($step,60*60));
53: croak "not a factor of 24: $h hours" if 24 % $h;
54: ! return sprintf ("0 *\/%d * * *", &$divide(24,$h))
55: ! }
56: ! }
57: }
58: }
59: }
今回、最も困ったのが、除算オペレータ/
の扱いです。
/
は、正規表現の区切り文字としても広く使われているのですが、
通常はそれを除算オペレータと混同することはないはずなのですけど、
Switch.pmはかなりの頻度で取り違えてしまいます
(取り違えず処理するときもあるので悩ましいのですが...)。
ということで、パーザをなだめすかしてコーディングしたら上のようになったわけです。
37行目のようにモジュールを実行時にロードしているのも、ご機嫌とりです:-P
除算はかなりの頻度で混乱を招くので、35行目に匿名関数を用意し、
switch...caseブロック中には
除算オペレータが混入しないようにしました。
45行目のswitchの引数はちょっと美しくないような気もしますけど (Damian Conwayも悩んだようで、別の記述法も用意されていますが、 たぶん、その逃げ道がエンバグの元凶でしょう...)、 やはりこの方がelsifを連ねるよりは遙かに気持ちいいですね:-)
Posted by Manabu Higashida at 10:35 PM
| Comments (0)
September 02, 2003
step to crontab
どんどんRRDs::rrdを拡充していきましょう。 RRDファイルから随時、構成情報を取り出せるようになったので、 asp/rrd/temp.plでcronオブジェクトの初期化している部分の crontab設定記述はRRDのステップ秒から生成したいですよね:
1: --- temp.pl 2003/09/01 06:12:16 2.6
2: +++ temp.pl 2003/09/03 13:12:14 2.7.1.1
3: @@ -104,8 +104,11 @@
4: inline_states =>
5: {
6: _start => sub {
7: - my $cron = DateTime::Event::Cron->new_from_cron("0,30 * * * *");
8: my $rrd = RRDs::temp->new( basename => 'temp', debug => $opt_d );
9: + $rrd->load_info();
10: + my $crontab = $rrd->step2crontab();
11: + print STDERR $crontab, "\n" if defined $opt_d;
12: + my $cron = DateTime::Event::Cron->new_from_cron($crontab);
13: $_[HEAP]->{cron} = $cron;
14: $_[HEAP]->{rrd} = $rrd;
15: $_[KERNEL]->alarm_set('rrd_temp', $cron->next()->epoch());
できる限り汎用的に利用できるようなstep2crontab()を書いてみました:
1: --- rrd.pm 2003/09/03 09:13:57 3.1
2: +++ rrd.pm 2003/09/03 09:29:14 3.2.1.1
3: @@ -5,6 +5,7 @@
4: package RRDs::rrd;
5:
6: use strict;
7: +use Carp;
8: use Data::Dumper;
9: use Time::HiRes qw(time);
10:
11: @@ -142,6 +143,31 @@
12: $self;
13: }
14:
15: +sub step2crontab {
16: + my $self = shift;
17: + my $step = $self->{step};
18: + croak "out of range: $step" if ( $step < 60 || $step > 86400 );
19: + if ( $step == 60 ) { # minutely
20: + return "* * * * *";
21: + } elsif ( $step == 3600 ) { # hourly
22: + return "0 * * * *";
23: + } elsif ( $step == 86400 ) { # daily
24: + return "0 0 * * *";
25: + } else {
26: + croak "too fractional: $step" if $step % 60;
27: + my $m = int($step/60);
28: + if ( $step < 3600 ) {
29: + croak "not a factor of 60: $m minutes" if 60 % $m;
30: + return sprintf ("*/%d * * * *", 60/$m);
31: + } elsif ( $step < 86400 ) {
32: + croak "too fractional: $step" if $m % 60;
33: + my $h = int($step/60/60);
34: + croak "not a factor of 24: $h hours" if 24 % $h;
35: + return sprintf ("0 */%d * * *", 24/$h);
36: + }
37: + }
38: +}
39: +
40: sub log {
41: my $self = shift;
42: my $fmt = shift;
見ての通りの制約は多々ありますが、 すべてのステップ秒の入力に対してcrontab設定を生成しようとするとうまくいくはずがありません。 現実的な1分以上、一日以下のステップ秒の入力に対して反応します。 また、時間や日の約数にならないステップ秒を実現するためのcrontab設定を生成しようとすると、 とてつもない組み合わせが必要になる場合がありますので (そういうときはPrologが便利なんですが:-P)、 いちいちそういうのは弾いています。
Prolog
というキーワードを思わず思い出してしまいましたが、
この種の記述をする際に、Perlってあまり美しくコーディングできないんですよね。
とにかくわたしはelsifが嫌いなんです:-P
ここはひとつ、組み込みPrologではなくて、Damian Conwayによる
Switch
を試してみましょうか...。
Posted by Manabu Higashida at 06:15 PM
| Comments (0)
September 01, 2003
load_info
asp/rrd/rrd-info.aspからrestore_args()を抜き出して、 RRDs::rrdに組み込んでみました:
1: --- rrd.pm 2003/09/01 09:52:45 2.4
2: +++ rrd.pm 2003/09/03 09:13:57 3.1
3: @@ -110,6 +110,38 @@
4: return 0;
5: }
6:
7: +sub load_info {
8: + my $self = shift;
9: + my $rref = RRDs::info($self->{rrd});
10: +# print Data::Dumper->Dump([$rref],[qw(rref)]);
11: +
12: + $self->{rrd_version} = $$rref{rrd_version};
13: + $self->{step} = $$rref{step};
14: + $self->{last_update} = $$rref{last_update};
15: +
16: + my %ds;
17: + foreach my $key (grep /^ds/, sort keys %$rref) {
18: + # print "$key = $$rref{$key}\n";
19: + if ( $key =~ /^ds\[([^\]]+)\]\.(\S+)$/ ) {
20: + $ds{$1}{$2} = $$rref{$key};
21: + }
22: + }
23: +# print Data::Dumper->Dump([\%ds],[qw(ds)]);
24: + $self->{ds} = \%ds;
25: +
26: + my %rra;
27: + foreach my $key (grep /^rra/, sort keys %$rref) {
28: + # print "$key = $$rref{$key}\n";
29: + if ( $key =~ /^rra\[([^\]]+)\]\.(\S+)$/ ) {
30: + $rra{$1}{$2} = $$rref{$key};
31: + }
32: + }
33: +# print Data::Dumper->Dump([\%rra],[qw(rra)]);
34: + $self->{rra} = \%rra;
35: +
36: + $self;
37: +}
38: +
39: sub log {
40: my $self = shift;
41: my $fmt = shift;
よ〜く考えてみると、RRDs::info()の戻り値をそのままインスタンス変数にバインドした方が 汎用性が高かったかもしれません:-P いや、RRDs::info()の戻り値のハッシュは、参照しにくいのでこの形にしたのでしたっけ...。 なら、やはりこちらの実装の方がよろしいようで:-)
Posted by Manabu Higashida at 06:15 PM
| Comments (0)