1#!/usr/bin/perl
2##########################################################################
3# Synchronizing appender output with Log::Log4perl::Appender::Synchronized.
4# This test uses fork and a semaphore to get two appenders to get into
5# each other/s way.
6# Mike Schilli, 2003 (m@perlmeister.com)
7##########################################################################
8
9BEGIN { 
10    if($ENV{INTERNAL_DEBUG}) {
11        require Log::Log4perl::InternalDebug;
12        Log::Log4perl::InternalDebug->enable();
13    }
14}
15
16use warnings;
17use strict;
18
19use Test::More;
20use Log::Log4perl qw(:easy);
21Log::Log4perl->easy_init($DEBUG);
22use constant INTERNAL_DEBUG => 0;
23
24our $INTERNAL_DEBUG = 0;
25
26$| = 1;
27
28BEGIN {
29    if(exists $ENV{"L4P_ALL_TESTS"}) {
30        plan tests => 5;
31    } else {
32        plan skip_all => "- only with L4P_ALL_TESTS";
33    }
34}
35
36use Log::Log4perl::Util::Semaphore;
37use Log::Log4perl qw(get_logger);
38use Log::Log4perl::Appender::Synchronized;
39
40my $EG_DIR = "eg";
41$EG_DIR = "../eg" unless -d $EG_DIR;
42
43my $logfile = "$EG_DIR/fork.log";
44
45our $lock;
46our $locker;
47our $locker_key  = "abc";
48
49unlink $logfile;
50
51#goto SECOND;
52
53#print "tie\n";
54$locker = Log::Log4perl::Util::Semaphore->new(
55    key => $locker_key,
56);
57
58print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
59
60my $conf = qq(
61log4perl.category.Bar.Twix          = WARN, Syncer
62
63log4perl.appender.Logfile           = Log::Log4perl::Appender::TestFileCreeper
64log4perl.appender.Logfile.autoflush = 1
65log4perl.appender.Logfile.filename  = $logfile
66log4perl.appender.Logfile.layout    = Log::Log4perl::Layout::PatternLayout
67log4perl.appender.Logfile.layout.ConversionPattern = %F{1}%L> %m%n
68
69log4perl.appender.Syncer           = Log::Log4perl::Appender::Synchronized
70log4perl.appender.Syncer.appender  = Logfile
71log4perl.appender.Syncer.key       = blah
72);
73
74$locker->semlock();
75
76Log::Log4perl::init(\$conf);
77
78my $pid = fork();
79
80die "fork failed" unless defined $pid;
81
82my $logger = get_logger("Bar::Twix");
83if($pid) {
84   #parent
85   $locker->semlock();
86   #print "Waiting for child\n";
87   for(1..10) {
88       #print "Parent: Writing\n";
89       $logger->error("X" x 4097);
90   }
91} else { 
92   #child
93   $locker->semunlock();
94   for(1..10) {
95       #print "Child: Writing\n";
96       $logger->error("Y" x 4097);
97   }
98   exit 0;
99}
100
101   # Wait for child to finish
102print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
103waitpid($pid, 0);
104print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
105
106my $clashes_found = 0;
107
108open FILE, "<$logfile" or die "Cannot open $logfile";
109while(<FILE>) {
110    if(/XY/ || /YX/) {
111        $clashes_found = 1;
112        last;
113    }
114}
115close FILE;
116
117unlink $logfile;
118#print $logfile, "\n";
119#exit 0;
120
121ok(! $clashes_found, "Checking for clashes in logfile");
122
123###################################################################
124# Test the Socket appender
125###################################################################
126
127use IO::Socket::INET;
128
129SECOND:
130
131unlink $logfile;
132
133#print "tie\n";
134$locker = Log::Log4perl::Util::Semaphore->new(
135    key => $locker_key,
136);
137
138$conf = q{
139    log4perl.category                  = WARN, Socket
140    log4perl.appender.Socket           = Log::Log4perl::Appender::Socket
141    log4perl.appender.Socket.PeerAddr  = localhost
142    log4perl.appender.Socket.PeerPort  = 12345
143    log4perl.appender.Socket.layout    = SimpleLayout
144};
145
146print "1 Semunlock\n" if $INTERNAL_DEBUG;
147print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
148$locker->semunlock();
149print "1 Done semunlock\n" if $INTERNAL_DEBUG;
150
151print "2 Semlock\n" if $INTERNAL_DEBUG;
152print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
153$locker->semlock();
154print "2 Done semlock\n" if $INTERNAL_DEBUG;
155
156#print "forking\n";
157$pid = fork();
158
159die "fork failed" unless defined $pid;
160
161if($pid) {
162   #parent
163   #print "Waiting for child\n";
164   print "Before semlock\n" if $INTERNAL_DEBUG;
165   $locker->semlock();
166   print "Done semlock\n" if $INTERNAL_DEBUG;
167
168   {
169       my $client = IO::Socket::INET->new( PeerAddr => 'localhost',
170                                           PeerPort => 12345,
171                                         );
172
173       #print "Checking connection\n";
174
175       if(defined $client) {
176           #print "Client defined, sending test\n";
177           eval { $client->send("test\n") };
178           if($@) {
179               #print "Send failed ($!), retrying ...\n";
180               sleep(1);
181               redo;
182           }
183       } else {
184           #print  "Server not responding yet ($!) ... retrying\n";
185           sleep(1);
186           redo;
187       }
188       $client->close();
189   }
190
191   Log::Log4perl::init(\$conf);
192   $logger = get_logger("Bar::Twix");
193   #print "Sending message\n";
194   $logger->error("Greetings from the client");
195} else { 
196   #child
197
198   #print STDERR "child starting\n";
199   my $sock = IO::Socket::INET->new(
200       Listen    => 5,
201       LocalAddr => 'localhost',
202       LocalPort => 12345,
203       ReuseAddr => 1,
204       Proto     => 'tcp');
205
206   die "Cannot start server: $!" unless defined $sock;
207       # Ready to receive
208   #print "Server started\n";
209   print "Before semunlock\n" if $INTERNAL_DEBUG;
210   $locker->semunlock();
211   print "After semunlock\n" if $INTERNAL_DEBUG;
212
213   my $nof_messages = 2;
214
215   open FILE, ">$logfile" or die "Cannot open $logfile";
216   while(my $client = $sock->accept()) {
217       #print "Client connected\n";
218       while(<$client>) {
219           print FILE "$_\n";
220           last;
221       }
222       last unless --$nof_messages;
223   }
224
225   close FILE;
226   exit 0;
227}
228
229   # Wait for child to finish
230print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
231waitpid($pid, 0);
232print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
233
234open FILE, "<$logfile" or die "Cannot open $logfile";
235my $data = join '', <FILE>;
236close FILE;
237
238unlink $logfile;
239
240like($data, qr/Greetings/, "Check logfile of Socket appender");
241
242###################################################################
243# Test the "silent_recover" options of the Socket appender
244###################################################################
245
246use IO::Socket::INET;
247
248our $TMP_FILE = "warnings.txt";
249END { unlink $TMP_FILE if defined $TMP_FILE; }
250
251# Capture STDERR to a temporary file and a filehandle to read from it
252open STDERR, ">$TMP_FILE";
253open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
254sub readwarn { return scalar <IN>; }
255
256$conf = q{
257    log4perl.category                        = WARN, Socket
258    log4perl.appender.Socket                 = Log::Log4perl::Appender::Socket
259    log4perl.appender.Socket.PeerAddr        = localhost
260    log4perl.appender.Socket.PeerPort        = 12345
261    log4perl.appender.Socket.layout          = SimpleLayout
262    log4perl.appender.Socket.silent_recovery = 1
263};
264
265    # issues a warning
266Log::Log4perl->init(\$conf);
267
268like(readwarn(), qr/Connection refused/, 
269     "Check if warning occurs on dead socket");
270
271$logger = get_logger("foobar");
272
273    # silently ignored
274$logger->warn("message lost");
275
276$locker->semunlock();
277$locker->semlock();
278
279    # Now start a server
280$pid = fork();
281
282if($pid) {
283   #parent
284
285       # wait for child
286   #print "Waiting for server to start\n";
287   $locker->semlock();
288   
289       # Send another message (should be sent)
290   #print "Sending message\n";
291   $logger->warn("message sent");
292} else { 
293   #child
294
295       # Start a server
296   my $sock = IO::Socket::INET->new(
297       Listen    => 5,
298       LocalAddr => 'localhost',
299       LocalPort => 12345,
300       ReuseAddr => 1,
301       Proto     => 'tcp');
302
303   die "Cannot start server: $!" unless defined $sock;
304       # Ready to receive
305   #print "Server started\n";
306   $locker->semunlock();
307
308   my $nof_messages = 1;
309
310   open FILE, ">$logfile" or die "Cannot open $logfile";
311   while(my $client = $sock->accept()) {
312       #print "Client connected\n";
313       while(<$client>) {
314           #print "Got message: $_\n";
315           print FILE "$_\n";
316           last;
317       }
318       last unless --$nof_messages;
319   }
320
321   close FILE;
322   exit 0;
323}
324
325   # Wait for child to finish
326print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
327waitpid($pid, 0);
328print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
329
330open FILE, "<$logfile" or die "Cannot open $logfile";
331$data = join '', <FILE>;
332close FILE;
333
334#print "data=$data\n";
335
336unlink $logfile;
337
338unlike($data, qr/message lost/, "Check logfile for lost message");
339like($data, qr/message sent/, "Check logfile for sent message");
340