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