This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ce0a5b1b90284cb5b01ed6707846225dc20c9644
[perl5.git] / cpan / Sys-Syslog / t / facilities-routing.t
1 #!perl -w
2 # --------------------------------------------------------------------
3 # Try to send messages with all combinations of facilities and levels
4 # to a POE syslog server.
5 # --------------------------------------------------------------------
6 use strict;
7 use warnings;
8
9 use Test::More;
10 use Socket;
11 use Sys::Syslog 0.30 qw< :standard :extended :macros >;
12
13
14 # check than POE is available
15 plan skip_all => "POE is not available" unless eval "use POE; 1";
16
17 # check than POE::Component::Server::Syslog is available and recent enough
18 plan skip_all => "POE::Component::Server::Syslog is not available"
19     unless eval "use POE::Component::Server::Syslog; 1";
20 plan skip_all => "POE::Component::Server::Syslog is too old"
21     if POE::Component::Server::Syslog->VERSION < 1.14;
22
23
24 my $host    = "127.0.0.1";
25 my $port    = 5140;
26 my $proto   = "udp";
27 my $ident   = "pocosyslog";
28
29 my @levels = qw< emerg alert crit err warning notice info debug >;
30 my @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
35 my %received;
36 my $parent_pid = $$;
37 my $child_pid  = fork();
38
39 if ($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 }
66 else {
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
99 sub 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
130 sub 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