use warnings;
use strict;
use Test::More;
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init($DEBUG);
use constant INTERNAL_DEBUG => 0;
our $INTERNAL_DEBUG = 0;
$| = 1;
BEGIN {
if(exists $ENV{"L4P_ALL_TESTS"}) {
plan tests => 5;
} else {
plan skip_all => "- only with L4P_ALL_TESTS";
}
}
use Log::Log4perl::Util::Semaphore;
use Log::Log4perl qw(get_logger);
use Log::Log4perl::Appender::Synchronized;
my $EG_DIR = "eg";
$EG_DIR = "../eg" unless -d $EG_DIR;
my $logfile = "$EG_DIR/fork.log";
our $lock;
our $locker;
our $locker_key = "abc";
unlink $logfile;
$locker = Log::Log4perl::Util::Semaphore->new(
key => $locker_key,
);
print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
my $conf = qq(
log4perl.category.Bar.Twix = WARN, Syncer
log4perl.appender.Logfile = Log::Log4perl::Appender::TestFileCreeper
log4perl.appender.Logfile.autoflush = 1
log4perl.appender.Logfile.filename = $logfile
log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
log4perl.appender.Logfile.layout.ConversionPattern = %F{1}%L> %m%n
log4perl.appender.Syncer = Log::Log4perl::Appender::Synchronized
log4perl.appender.Syncer.appender = Logfile
log4perl.appender.Syncer.key = blah
);
$locker->semlock();
Log::Log4perl::init(\$conf);
my $pid = fork();
die "fork failed" unless defined $pid;
my $logger = get_logger("Bar::Twix");
if($pid) {
$locker->semlock();
for(1..10) {
$logger->error("X" x 4097);
}
} else {
$locker->semunlock();
for(1..10) {
$logger->error("Y" x 4097);
}
exit 0;
}
print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
my $clashes_found = 0;
open FILE, "<$logfile" or die "Cannot open $logfile";
while(<FILE>) {
if(/XY/ || /YX/) {
$clashes_found = 1;
last;
}
}
close FILE;
unlink $logfile;
ok(! $clashes_found, "Checking for clashes in logfile");
use IO::Socket::INET;
SECOND:
unlink $logfile;
$locker = Log::Log4perl::Util::Semaphore->new(
key => $locker_key,
);
$conf = q{
log4perl.category = WARN, Socket
log4perl.appender.Socket = Log::Log4perl::Appender::Socket
log4perl.appender.Socket.PeerAddr = localhost
log4perl.appender.Socket.PeerPort = 12345
log4perl.appender.Socket.layout = SimpleLayout
};
print "1 Semunlock\n" if $INTERNAL_DEBUG;
print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
$locker->semunlock();
print "1 Done semunlock\n" if $INTERNAL_DEBUG;
print "2 Semlock\n" if $INTERNAL_DEBUG;
print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
$locker->semlock();
print "2 Done semlock\n" if $INTERNAL_DEBUG;
$pid = fork();
die "fork failed" unless defined $pid;
if($pid) {
print "Before semlock\n" if $INTERNAL_DEBUG;
$locker->semlock();
print "Done semlock\n" if $INTERNAL_DEBUG;
{
my $client = IO::Socket::INET->new( PeerAddr => 'localhost',
PeerPort => 12345,
);
if(defined $client) {
eval { $client->send("test\n") };
if($@) {
sleep(1);
redo;
}
} else {
sleep(1);
redo;
}
$client->close();
}
Log::Log4perl::init(\$conf);
$logger = get_logger("Bar::Twix");
$logger->error("Greetings from the client");
} else {
my $sock = IO::Socket::INET->new(
Listen => 5,
LocalAddr => 'localhost',
LocalPort => 12345,
ReuseAddr => 1,
Proto => 'tcp');
die "Cannot start server: $!" unless defined $sock;
print "Before semunlock\n" if $INTERNAL_DEBUG;
$locker->semunlock();
print "After semunlock\n" if $INTERNAL_DEBUG;
my $nof_messages = 2;
open FILE, ">$logfile" or die "Cannot open $logfile";
while(my $client = $sock->accept()) {
while(<$client>) {
print FILE "$_\n";
last;
}
last unless --$nof_messages;
}
close FILE;
exit 0;
}
print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
open FILE, "<$logfile" or die "Cannot open $logfile";
my $data = join '', <FILE>;
close FILE;
unlink $logfile;
like($data, qr/Greetings/, "Check logfile of Socket appender");
use IO::Socket::INET;
our $TMP_FILE = "warnings.txt";
END { unlink $TMP_FILE if defined $TMP_FILE; }
open STDERR, ">$TMP_FILE";
open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
sub readwarn { return scalar <IN>; }
$conf = q{
log4perl.category = WARN, Socket
log4perl.appender.Socket = Log::Log4perl::Appender::Socket
log4perl.appender.Socket.PeerAddr = localhost
log4perl.appender.Socket.PeerPort = 12345
log4perl.appender.Socket.layout = SimpleLayout
log4perl.appender.Socket.silent_recovery = 1
};
Log::Log4perl->init(\$conf);
like(readwarn(), qr/Connection refused/,
"Check if warning occurs on dead socket");
$logger = get_logger("foobar");
$logger->warn("message lost");
$locker->semunlock();
$locker->semlock();
$pid = fork();
if($pid) {
$locker->semlock();
$logger->warn("message sent");
} else {
my $sock = IO::Socket::INET->new(
Listen => 5,
LocalAddr => 'localhost',
LocalPort => 12345,
ReuseAddr => 1,
Proto => 'tcp');
die "Cannot start server: $!" unless defined $sock;
$locker->semunlock();
my $nof_messages = 1;
open FILE, ">$logfile" or die "Cannot open $logfile";
while(my $client = $sock->accept()) {
while(<$client>) {
print FILE "$_\n";
last;
}
last unless --$nof_messages;
}
close FILE;
exit 0;
}
print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
open FILE, "<$logfile" or die "Cannot open $logfile";
$data = join '', <FILE>;
close FILE;
unlink $logfile;
unlike($data, qr/message lost/, "Check logfile for lost message");
like($data, qr/message sent/, "Check logfile for sent message");