【Perl】 Log::Dispatchで、TCP経由でsyslogを送信する際の注意点
投稿日： / 更新日：
この記事は2年以上前に書かれたものです。情報が古い可能性があります。
少し前に、TCP経由でsyslogメッセージを送信するプログラムを作成する必要があり、Perlでそれを作成したのですが、その時にちょっとした罠に引っかかってしまったので、備忘録の意味合いも込めてご紹介したいと思います。
2012/08/19追記: Sys::Syslogの最新版では、ここでご紹介したバグが修正されています。こちらもご覧ください。
Perlでログを出力させたい場合、良く使われるフレームワークとしてLog::Dispatchがあります。このモジュールを使用することで、ファイルや画面、メールやsyslogなど、様々な出力先へ簡単にログを出力することができます。
以下は、Log::Dispatchを使用した簡単なサンプルスクリプトです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
#!/usr/bin/env perl use strict; use warnings; use File::Basename 'basename'; use Getopt::Long; use Log::Dispatch; our $VERSION = 0.01; our $DEF_HOST = 'localhost'; our $DEF_PROTO = 'udp'; our $DEF_FAC = 'user.notice'; my $prog = basename($0); my $usage = << "END_OF_USAGE"; USAGE: $prog [-d DESTINATION] [-p PROTOCOL] [-f FACILITY.PRIORITY] MESSAGE OPTIONS: -d|--destination ip address or hostname (default '$DEF_HOST') -p|--protocol tcp or udp (default '$DEF_PROTO') -f|--facility facility.priority (default '$DEF_FAC') -h|--help this message (which you're reading) -v|--version show version END_OF_USAGE my $opts_are_parsed = GetOptions( "destination=s" => \my $dest, "protocol=s" => \my $proto, "facility=s" => \my $fac, "help" => \my $show_help, "version" => \my $show_version, ); $dest //= $DEF_HOST; $proto //= $DEF_PROTO; $fac //= $DEF_FAC; my $message = shift; if (not $opts_are_parsed or $show_help or $proto !~ /tcp|udp/ or $fac !~ /\w+\.\w+/ or not defined $message) { die $usage; } elsif ($show_version) { die "$prog: VERSION $VERSION\n"; } my ($facility, $priority) = split /\./, $fac; my $logger = Log::Dispatch->new( outputs => [ [ 'Syslog' => ( min_level => 'debug', facility => $facility, socket => [ $proto, $dest ], ) ], ], ); eval { $logger->$priority($message); }; if ($@) { die "$prog: failed to send syslog: invalid facility/priority.\n"; } __END__ |
使用法は以下のとおりです。なお、-dオプションを使用すると、指定したホスト上のsyslogデーモンへ直接メッセージを送信することができます。
|
1 2 3 |
$ ./logtrans.pl hello $ ./logtrans.pl -f user.error hello $ ./logtrans.pl -d 192.168.11.113 -f daemon.notice hello |
しかし、以下のようにtcpでsyslogを送信しようとすると、エラーが発生してしまいます。
|
1 2 |
$ ./logtrans.pl -d 192.168.11.113 -p tcp hello setlogsock(): type='tcp': TCP service unavailable at /home/atomitech/perl5/perlbrew/perls/perl-5.14.2/lib/site_perl/5.14.2/Log/Dispatch/Syslog.pm line 75. |
Log::Dispatch::Syslogの75行目辺りを見ると、次のようになっています。
|
1 2 3 |
Sys::Syslog::setlogsock( ref $self->{socket} ? @{ $self->{socket} } : $self->{socket} ) if defined $self->{socket}; |
ここで、Sys::Syslogというモジュールの、setlogsockというサブルーチンの呼び出しに失敗した模様です。モジュール側の実装を見てみます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
my %mechanism = ( ...snip... tcp => { check => sub { if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { $host = $syslog_path; return 1 } else { return } }, err_msg => "TCP service unavailable", }, ...snip... sub connect_tcp { my ($errs) = @_; ...snip... my $port = $sock_port || getservbyname('syslog', 'tcp'); $port = getservbyname('syslogng', 'tcp') unless defined $port; if (!defined $port) { push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp"; return 0; } |
getservbyname関数を使用して、syslogサービスがシステムに登録されているかどうかを確認し、またポート番号を取得しようとしています。私の環境（CentOS 6.2）では、次のようになっていました。
|
1 2 3 4 5 6 7 8 9 |
$ egrep "\b514\b" /etc/services shell 514/tcp cmd # no passwords used syslog 514/udp $ grep syslog /etc/services syslog 514/udp syslog-conn 601/tcp # Reliable Syslog Service syslog-conn 601/udp # Reliable Syslog Service syslog-tls 6514/tcp # Syslog over TLS |
上記のように、tcpのsyslogサービスに関するエントリはそもそも存在しないようです。従って、これはSys::Syslogのバグである可能性があります。CPANモジュールのバグトラッカであるrt.cpan.orgで確認したところ、ほんの数日前に、このバグに関するチケットが登録されていました。
Bug #78044 for Sys-Syslog: Incorrectly requires /etc/services entries for TCP
明らかなバグですが、モジュールのメンテナーが対応しない限り、このままではtcpでsyslogを送信することができません。暫定対処として、やや強引ですが、このモジュールに直接パッチを当てます。差分は以下のとおりです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
$ diff -uwb Syslog.pm.orig Syslog.pm --- Syslog.pm.orig 2012-07-02 13:19:31.502288501 +0900 +++ Syslog.pm 2012-07-07 20:59:28.501198525 +0900 @@ -227,7 +227,8 @@ }, tcp => { check => sub { - if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { + #if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { + if (1) { $host = $syslog_path; return 1 } @@ -605,12 +606,13 @@ return 0; } - my $port = $sock_port || getservbyname('syslog', 'tcp'); - $port = getservbyname('syslogng', 'tcp') unless defined $port; - if (!defined $port) { - push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp"; - return 0; - } + my $port = $sock_port || 514; + #my $port = $sock_port || getservbyname('syslog', 'tcp'); + #$port = getservbyname('syslogng', 'tcp') unless defined $port; + #if (!defined $port) { + #push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp"; + #return 0; + #} my $addr; if (defined $host) { |
これにより、tcpでのsyslogメッセージ送信が無事行えるようになりました。
|
1 2 3 4 5 6 7 8 |
(source host) $ ./logtrans.pl -d 192.168.11.113 hello_udp $ ./logtrans.pl -d 192.168.11.113 -p tcp hello_tcp (destination host) $ sudo tail -f /var/log/messages Jul 7 21:04:15 192.168.11.112 [user:notice] ./logtrans.pl: hello_udp Jul 7 21:04:21 192.168.11.112 [user:notice] ./logtrans.pl: hello_tcp |
以上、Perlでのsyslog送信に関する簡単な話題をご紹介しました。
