Bug #63544 for Log-Dispatch-FileRotate: if lockfile can't be opened, nothing is logged but no failure is reported

Here's a diff with more context, makes it easier to see what's going on.

diff -Naur -U20 Log-Dispatch-FileRotate-1.19.orig/FileRotate.pm Log-Dispatch-FileRotate-1.19/FileRotate.pm --- Log-Dispatch-FileRotate-1.19.orig/FileRotate.pm 2008-10-20 16:32:07.000000000 -0700 +++ Log-Dispatch-FileRotate-1.19/FileRotate.pm 2010-12-02 10:15:45.444431221 -0800 @@ -174,41 +174,41 @@ sub log_message { my $self = shift; my %p = @_; my $max_size = $self->{size}; my $numfiles = $self->{max}; my $name = $self->{params}->{filename}; my $fh = $self->{LDF}->{fh}; # Prime our time based data outside the critical code area my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); # Handle critical code for logging. No changes if someone else is in if( !$self->lfhlock_test() ) { warn "$$ waiting on lock\n" if $self->{debug}; unless($self->lfhlock()) { - warn "$$ failed to get lock. returning\n" if $self->{debug}; + warn qq{$$ LogRotate failed to get lock: "$self->{_lfhlock_test_err}". Not logging...\n}; return; } warn "$$ got lock after wait\n" if $self->{debug}; } my $size = (stat($fh))[7]; # Stat the handle to get real size my $inode = (stat($fh))[1]; # get real inode my $finode = (stat($name))[1]; # Stat the name for comparision warn localtime()." $$ s=$size, i=$inode, f=". (defined $finode ? $finode : "undef") . ", n=$name\n" if $self->{debug}; # If finode and inode are the same then nobody has done a rename # under us and we can continue. Otherwise just close and reopen. # Time mode overrides Size mode if(!defined($finode) || $inode != $finode) { # Oops someone moved things on us. So just reopen our log delete $self->{LDF}; # Should get rid of current LDF $self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log @@ -594,40 +594,41 @@ # don't work properly between the parent and children. Anyone can grab a # lock while someone else thinks they have it. To work properly the # "open" has to be done within each process. # # Thanks Dan sub lfhlock_test { my $self = shift; if (open(LFH, ">>$self->{lf}")) { $self->{lfh} = *LFH; if (flock($self->{lfh}, LOCK_EX | LOCK_NB)) { warn "$$ got lock on Lock File ".$self->{lfh}."\n" if $self->{debug}; return 1; } } else { + $self->{_lfhlock_test_err} = "couldn't lock $self->{lf}: $!"; $self->{lfh} = 0; warn "$$ couldn't get lock on Lock File\n" if $self->{debug}; return 0; } } sub lfhlock { my $self = shift; if (!$self->{lfh}) { if (!open(LFH, ">>$self->{lf}")) { return 0; } $self->{lfh} = *LFH; } flock($self->{lfh},LOCK_EX); diff -Naur -U20 Log-Dispatch-FileRotate-1.19.orig/test.pl Log-Dispatch-FileRotate-1.19/test.pl --- Log-Dispatch-FileRotate-1.19.orig/test.pl 2008-10-20 16:32:07.000000000 -0700 +++ Log-Dispatch-FileRotate-1.19/test.pl 2010-12-02 10:17:12.260844470 -0800 @@ -1,31 +1,31 @@ #!/usr/bin/perl -w # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) -BEGIN { $| = 1; print "1..8\n"; } +BEGIN { $| = 1; print "1..9\n"; } END {print "not ok 1\n" unless $loaded;} use Log::Log4perl; use Log::Dispatch::FileRotate; $loaded = 1; print "ok 1\n"; if ($^O eq 'cygwin') { # Date::Manip doesn't like Cygwin's TZ value. $ENV{TZ} = (split " ",(`date`)[0])[4]; } ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): # First lets build a conf file for use latter use Date::Manip; @@ -159,21 +159,61 @@ Log::Log4perl::get_logger("")->info( "count=$count" ); Log::Log4perl::get_logger("")->info( "count=$count" ); Log::Log4perl::get_logger("")->info( "count=$count" ); if(! -f "test.log") { print "not "; } print "ok 6\n"; if(! -f "test.log.1") { print "not "; } print "ok 7\n"; # This shouldn't exist if(-f "test.log.2") { print "not "; } print "ok 8\n"; + +############################ +# lockfile handling + +my $lockfile_test = 'testlock.log'; +unlink $lockfile_test; +$config = <<EOL; +log4perl.logger = INFO, default +log4perl.appender.default = Log::Dispatch::FileRotate +log4perl.appender.default.filename = $lockfile_test +log4perl.appender.default.mode = append +log4perl.appender.default.layout = SimpleLayout +log4perl.appender.default.max = 6 +log4perl.appender.default.DatePattern = yyyy-MM-dd-HH +EOL + +Log::Log4perl::init(\$config); + +$logger->info("write with successful lock"); + +# look up the lockfile name +my $appender = Log::Log4perl->appender_by_name('default'); +my $lockfile = $appender->{lf}; # .testlock.log.LCK + +# somebody borks the lockfile +chmod 0, $lockfile; + +# this should throw a warning +$logger->info("where's my log?"); + +# if the string actually showed up in the log file, then our assumptions are wrong +open (my $fh, $lockfile_test); +my $got = do { local $/ = undef; <$fh> }; +if ($got =~ /where's my log/){ + print "not "; +} +print "ok 9"; + +unlink $lockfile_test; + unlink $_ for <test.log*>;