1#!perl -w 2# -------------------------------------------------------------------- 3# Try to send messages with all combinations of facilities and levels 4# to a POE syslog server. 5# -------------------------------------------------------------------- 6use strict; 7use warnings; 8 9use Test::More; 10use Socket; 11use Sys::Syslog 0.30 qw< :standard :extended :macros >; 12 13 14# check than POE is available 15plan skip_all => "POE is not available" unless eval "use POE; 1"; 16 17# check than POE::Component::Server::Syslog is available and recent enough 18plan skip_all => "POE::Component::Server::Syslog is not available" 19 unless eval "use POE::Component::Server::Syslog; 1"; 20plan skip_all => "POE::Component::Server::Syslog is too old" 21 if POE::Component::Server::Syslog->VERSION < 1.14; 22 23 24my $host = "127.0.0.1"; 25my $port = 5140; 26my $proto = "udp"; 27my $ident = "pocosyslog"; 28 29my @levels = qw< emerg alert crit err warning notice info debug >; 30my @facilities = qw< 31 auth cron daemon ftp kern lpr mail news syslog user uucp 32 local0 local1 local2 local3 local4 local5 local6 local7 33>; 34 35my %received; 36my $parent_pid = $$; 37my $child_pid = fork(); 38 39if ($child_pid) { 40 # parent: setup a syslog server 41 POE::Component::Server::Syslog->spawn( 42 Alias => 'syslog', 43 Type => $proto, 44 BindAddress => $host, 45 BindPort => $port, 46 47 InputState => \&client_input, 48 ErrorState => \&client_error, 49 ); 50 51 # signal handlers 52 POE::Kernel->sig_child($child_pid, sub { wait() }); 53 $SIG{TERM} = sub { 54 POE::Kernel->post(syslog => "shutdown"); 55 POE::Kernel->stop; 56 }; 57 58 # run everything 59 plan tests => @facilities * @levels * 2; 60 POE::Kernel->run; 61 62 # check if some messages are missing 63 my @miss = grep { $received{$_} < 2 } keys %received; 64 diag "@miss" if @miss; 65} 66else { 67 # child: send messages to the syslog server 68 sleep 2; 69 setlogsock({ host => $host, type => $proto, port => $port }); 70 71 # first way, set the facility each time with openlog() 72 for my $facility (@facilities) { 73 openlog($ident, "ndelay,pid", $facility); 74 75 for my $level (@levels) { 76 eval { syslog($level => "<$facility\:$level>") } 77 or warn "error: syslog($level => '<$facility\:$level>'): $@"; 78 } 79 } 80 81 # second way, set the facility once with openlog(), then set 82 # the message facility with syslog() 83 openlog($ident, "ndelay,pid", "user"); 84 85 for my $facility (@facilities) { 86 for my $level (@levels) { 87 eval { syslog("$facility.$level" => "<$facility\:$level>") } 88 or warn "error: syslog('$facility.$level' => '<$facility\:$level>'): $@"; 89 } 90 } 91 92 sleep 2; 93 94 # send SIGTERM to the parent 95 kill 15 => $parent_pid; 96} 97 98 99sub client_input { 100 my $message = $_[&ARG0]; 101 102 # extract the sent facility and level from the message text 103 my ($sent_facility, $sent_level) = $message->{msg} =~ /<(\w+):(\w+)>/; 104 $received{"$sent_facility\:$sent_level"}++; 105 106 # resolve their numeric values 107 my ($sent_fac_num, $sent_lev_num); 108 { 109 no strict "refs"; 110 $sent_fac_num = eval { my $n = uc "LOG_$sent_facility"; &$n } >> 3; 111 $sent_lev_num = eval { my $n = uc "LOG_$sent_level"; &$n }; 112 } 113 114 is_deeply( 115 { # received message 116 facility => $message->{facility}, 117 severity => $message->{severity}, 118 }, 119 { # sent message 120 facility => $sent_fac_num, 121 severity => $sent_lev_num, 122 }, 123 "sent<facility=$sent_facility($sent_fac_num), level=$sent_level" . 124 "($sent_lev_num)> - rcvd<facility=$message->{facility}, " . 125 "level=$message->{severity}>" 126 ); 127} 128 129 130sub client_error { 131 my $message = $_[&ARG0]; 132 133 require Data::Dumper; 134 $Data::Dumper::Indent = 0; $Data::Dumper::Indent = 0; 135 $Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1; 136 fail "checking syslog message"; 137 diag "[client_error] message = ", Data::Dumper::Dumper($message); 138 139 kill 15 => $child_pid; 140 POE::Kernel->post(syslog => "shutdown"); 141 POE::Kernel->stop; 142} 143 144