Perl Net::Server Log Buffer cuts off at 4096 characters

user_4755612 0
Viewed 78

I am using Perl Net::Server and using the built in log method like

$self->log( 1, lc( $json->encode($callInfo) ) );

The issue that I am having is sometimes the data in $callInfo is larger than 4096 characters and it writes 4096 characters to the log file and then a child writes to the log with it's $callInfo and then the rest of the original $callInfo gets logged.

Example: Assuming abcdef is over 4096 characters.

callinfo1 -> child process tries to write 'abcdef' to log where 'abc' would be written and interrupted by the next child process

callinfo2 -> another child process writes to the log and then the remaining data 'def' from callinfo1 would get written.

I have tried adding the following and change the buffer size to 8192 but the issue remains.

sub post_configure {
  94     my $self = shift;
  95     my $prop = $self->{server};
  96     $prop->{log_level} = 1;
  97 
  98     if( $prop->{log_file} ){
  99         local $/ = 8192;
 100         open(_SERVER_LOG, ">>$prop->{log_file}") or die "Couldn't open log file \"$prop->{log_file}\" [$!].";
 101         _SERVER_LOG->autoflush(1);
 102         #open(our $logHandler, '>>', $prop->{log_file});
 103         #$logHandler->autoflush(1);
 104         $prop->{chown_log_file} = 1;
 105     }
 106 }
 107 
 108 sub log {
 109     my $self  = shift;
 110     my $prop = $self->{server};
 111     my $level = shift;
 112     $self->write_to_log_hook($level,@_);
 113 }
 114 
 115 
 116 sub write_to_log_hook {
 117     my $self  = shift;
 118     my $prop = $self->{server};
 119     my $level = shift;
 120     local $_  = shift || '';
 121     chomp;
 122     s/([^\n\ -\~])/sprintf("%%%02X",ord($1))/eg;
 123 
 124     if( $prop->{log_file} ){
 125         #if(substr($_, 0, 1) eq '{')
 126         #{    
 127             print _SERVER_LOG $_, "\n";
 128             #print $logHandler $_, "\n";
 129         #}
 130     }
 131 }

Any ideas on how to get the log buffer to finish before another child process logs?

Thanks in advance.

perl sockets
1 Answers

Perl doesn't send everything to OS at once, even with autoflush, so it's possible for a print to be interrupted by other processes.

$ strace perl -e'STDOUT->autoflush; print "x" x 9999' 2>&1 >/dev/null | grep write
write(1, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"..., 8192) = 8192
write(1, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"..., 1807) = 1807

That said, the OS only guarantees that writes under a certain size are atomic, so large prints could still be interrupted even if Perl sent everything to the OS at once.

This means it's up to the processes to synchronize themselves using some form of mutual exclusion (e.g. by using a lock).

user_5899240
Related