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 = sort grep { $received{$_} < 2 } keys %received;
64    diag "@miss" if @miss;
65}
66else {
67    # child: send messages to the syslog server
68    sleep 2;
69    my $delay = .01;
70    setlogsock({ host => $host, type => $proto, port => $port });
71
72    # first way, set the facility each time with openlog()
73    for my $facility (@facilities) {
74        openlog($ident, "ndelay,pid", $facility);
75
76        for my $level (@levels) {
77            eval { syslog($level => "<$facility\:$level>") }
78                or warn "error: syslog($level => '<$facility\:$level>'): $@";
79            select undef, undef, undef, $delay;
80        }
81    }
82
83    # second way, set the facility once with openlog(), then set
84    # the message facility with syslog()
85    openlog($ident, "ndelay,pid", "user");
86
87    for my $facility (@facilities) {
88        for my $level (@levels) {
89            eval { syslog("$facility.$level" => "<$facility\:$level>") }
90                or warn "error: syslog('$facility.$level' => '<$facility\:$level>'): $@";
91            select undef, undef, undef, $delay;
92        }
93    }
94
95    sleep 2;
96
97    # send SIGTERM to the parent
98    kill 15 => $parent_pid;
99}
100
101
102sub client_input {
103    my $message = $_[&ARG0];
104
105    # extract the sent facility and level from the message text
106    my ($sent_facility, $sent_level) = $message->{msg} =~ /<(\w+):(\w+)>/;
107    $received{"$sent_facility\:$sent_level"}++;
108
109    # resolve their numeric values
110    my ($sent_fac_num, $sent_lev_num);
111    {
112        no strict "refs";
113        $sent_fac_num = eval { my $n = uc "LOG_$sent_facility"; &$n } >> 3;
114        $sent_lev_num = eval { my $n = uc "LOG_$sent_level";    &$n };
115    }
116
117    is_deeply(
118        {   # received message
119            facility => $message->{facility},
120            severity => $message->{severity},
121        },
122        {   # sent message
123            facility => $sent_fac_num,
124            severity => $sent_lev_num,
125        },
126        "sent<facility=$sent_facility($sent_fac_num), level=$sent_level" .
127        "($sent_lev_num)> - rcvd<facility=$message->{facility}, " .
128        "level=$message->{severity}>"
129    );
130}
131
132
133sub client_error {
134    my $message = $_[&ARG0];
135
136    require Data::Dumper;
137    $Data::Dumper::Indent   = 0;    $Data::Dumper::Indent   = 0;
138    $Data::Dumper::Sortkeys = 1;    $Data::Dumper::Sortkeys = 1;
139    fail "checking syslog message";
140    diag "[client_error] message = ", Data::Dumper::Dumper($message);
141
142    kill 15 => $child_pid;
143    POE::Kernel->post(syslog => "shutdown");
144    POE::Kernel->stop;
145}
146
147