I have a script that writes out to a file on a frequent basis using AnyEvent. I've written the following sample to illustrate the issue I'm facing.
#!/usr/bin/perl
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Handle;
my $outputFile = 'out_test.log';
open my $out, ">>", $outputFile or die "Can't open output\n";
my $data = "test string"x50000 . "\n";
my $out_ready = AnyEvent->condvar;
my $out_hdl; $out_hdl = AnyEvent::Handle->new(
fh => $out,
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
AE::log error => $msg;
$hdl->destroy;
$out_ready->send;
}
);
my $timer = AnyEvent->timer(
after => 0,
interval => 5,
cb => sub {
$out_hdl->push_write($data);
}
);
$out_ready->recv;
This works well, but the file size gets to be enormous after a while. We use logrotate for problems like this so I created the following logrotate configuration file.
/path/to/out_test.log {
size 2M
copytruncate
rotate 4
}
This also works well, and any time the above output file exceeds 2M it is rotated to out_test.log.1. However, when out_test.log is written to immediately after rotation, the file size is the same as the rotated log file. This behavior and what I'm experiencing is explained here: https://serverfault.com/a/221343
While I understand the issue, I don't know how to fix the problem in the sample Perl code I provided.
I don't have to implement log rotation via logrotate, but it would be preferred. If it's simple to implement in the script I can do that, but it would be nice if I could make the above sample play nice with logrotate. Any help or comments are appreciated. Thanks!
EDIT
Based on the answers below I was able to get things working with the monkeypatch ikegami provided as well as leveraging native perl I/O as per Marc Lehmann's advice. My example code looks like this and works well. Additionally this removes the requirement for the copytruncate directive in logrotate.
#!/usr/bin/perl
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Handle;
my $outputFile = 'out_test.log';
open my $out, ">>", $outputFile or die "Can't open output\n";
my $data = "test string"x50000 . "\n";
my $cv = AnyEvent::condvar();
my $timer = AnyEvent->timer(
after => 0,
interval => 5,
cb => sub {
open my $out, ">>", $outputFile or die "Can't open output\n";
print $out $data;
close $out;
}
);
$cv->recv;
Normally, writing to a handle opened for append handle first seeks to the end of the file.
If the file was
open(2)ed withO_APPEND, the file offset is first set to the end of the file before writing. The adjustment of the file offset and the write operation are performed as an atomic step.
But you're not seeing that with AnyEvent::Handle. The following demonstrates the problem:
$ perl -e'
use strict;
use warnings;
use AE qw( );
use AnyEvent::Handle qw( );
sub wait_for_drain {
my ($hdl) = @_;
my $drained = AE::cv();
$hdl->on_drain($drained);
$drained->recv();
}
my $qfn = "log";
unlink($qfn);
open(my $fh, ">>", $qfn) or die $!;
$fh->autoflush(1);
my $hdl = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
if ($fatal) { die($msg); } else { warn($msg); }
},
);
$hdl->push_write("abc\n");
$hdl->push_write("def\n");
wait_for_drain($hdl);
print(-s $qfn, "\n");
truncate($qfn, 0);
print(-s $qfn, "\n");
$hdl->push_write("ghi\n");
wait_for_drain($hdl);
print(-s $qfn, "\n");
'
8
0
12
While the following illustrates the behaviour you should be seeing:
$ perl -e'
use strict;
use warnings;
my $qfn = "log";
unlink($qfn);
open(my $fh, ">>", $qfn) or die $!;
$fh->autoflush(1);
print($fh "abc\n");
print($fh "def\n");
print(-s $qfn, "\n");
truncate($qfn, 0);
print(-s $qfn, "\n");
print($fh "ghi\n");
print(-s $qfn, "\n");
'
8
0
4
The problem is that AnyEvent::Handle clobbers some of the handle's flag. The AnyEvent code above boils down to the following:
$ perl -e'
use strict;
use warnings;
use Fcntl qw( F_SETFL O_NONBLOCK );
my $qfn = "log";
unlink($qfn);
open(my $fh, ">>", $qfn) or die $!;
$fh->autoflush(1);
fcntl($fh, F_SETFL, O_NONBLOCK);
print($fh "abc\n");
print($fh "def\n");
print(-s $qfn, "\n");
truncate($qfn, 0);
print(-s $qfn, "\n");
print($fh "ghi\n");
print(-s $qfn, "\n");
'
8
0
12
The following is what AnyEvent::Handle should be doing instead:
$ perl -e'
use strict;
use warnings;
use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
my $qfn = "log";
unlink($qfn);
open(my $fh, ">>", $qfn) or die $!;
$fh->autoflush(1);
my $flags = fcntl($fh, F_GETFL, 0)
or die($!);
fcntl($fh, F_SETFL, $flags | O_NONBLOCK)
or die($!);
print($fh "abc\n");
print($fh "def\n");
print(-s $qfn, "\n");
truncate($qfn, 0);
print(-s $qfn, "\n");
print($fh "ghi\n");
print(-s $qfn, "\n");
'
8
0
4
I have submitted a bug report, but the author of the module is unwilling to fix the bug, so I'm forced to recommend the rather awful practice of monkey patching. Add the following to your program:
use AnyEvent qw( );
use AnyEvent::Util qw( );
use Fcntl qw( );
BEGIN {
if (!AnyEvent::WIN32) {
my $fixed_fh_nonblocking = sub($$) {
my $flags = fcntl($_[0], Fcntl::F_GETFL, 0)
or return;
$flags = $_[1]
? $flags | AnyEvent::O_NONBLOCK
: $flags & ~AnyEvent::O_NONBLOCK;
fcntl($_[0], AnyEvent::F_SETFL, $flags);
};
no warnings "redefine";
*AnyEvent::Util::fh_nonblocking = $fixed_fh_nonblocking;
}
}
With this fix, your program will work correctly
$ perl -e'
use strict;
use warnings;
use AE qw( );
use AnyEvent qw( );
use AnyEvent::Handle qw( );
use AnyEvent::Util qw( );
use Fcntl qw( );
BEGIN {
if (!AnyEvent::WIN32) {
my $fixed_fh_nonblocking = sub($$) {
my $flags = fcntl($_[0], Fcntl::F_GETFL, 0)
or return;
$flags = $_[1]
? $flags | AnyEvent::O_NONBLOCK
: $flags & ~AnyEvent::O_NONBLOCK;
fcntl($_[0], AnyEvent::F_SETFL, $flags);
};
no warnings "redefine";
*AnyEvent::Util::fh_nonblocking = $fixed_fh_nonblocking;
}
}
sub wait_for_drain {
my ($hdl) = @_;
my $drained = AE::cv();
$hdl->on_drain($drained);
$drained->recv();
}
my $qfn = "log";
unlink($qfn);
open(my $fh, ">>", $qfn) or die $!;
$fh->autoflush(1);
my $hdl = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
if ($fatal) { die($msg); } else { warn($msg); }
},
);
$hdl->push_write("abc\n");
$hdl->push_write("def\n");
wait_for_drain($hdl);
print(-s $qfn, "\n");
truncate($qfn, 0);
print(-s $qfn, "\n");
$hdl->push_write("ghi\n");
wait_for_drain($hdl);
print(-s $qfn, "\n");
'
8
0
4