Marcus Marcus - 3 months ago 12
Perl Question

IO::Socket:SSL sometimes adds newline when printing on socket



I have a method that sends a message to a remote SSL server. The class is embedded in a program that may be called from the command line, or the program can be started as a daemon and may call the class method on request. I use

to launch the daemon:

package myserver;

use 5.10.1;
use strict;
use warnings;

use parent 'Net::Server::Fork';

myserver->run(
'port' => $main::config{'backend.ssl.host'} . '/ssl',
'ipv' => '*',
'log_level' => $main::config{'backend.loglevel'},
'log_file' => $main::config{'backend.logfile'},
'pid_file' => $main::config{'backend.pidfile'},
'user' => $main::config{'backend.user'},
'group' => $main::config{'backend.group'},
'max_servers' => $main::config{'backend.maxconnections'},
'background' => !$main::config{'backend.foreground'},
'leave_children_open_on_hup' => 1,
'allow' => $main::config{'ip'},
'reverse_lookups' => 1,
'SSL_key_file' => $main::config{'backend.ssl.key'},
'SSL_cert_file' => $main::config{'backend.ssl.crt'},
'SSL_ca_file' => $main::config{'backend.ssl.bundle'},
);

sub process_request {
# call connect and sendframe if requested
};


The external communication class connects with
IO::Socket::SSL
and sends data by prepending the packet length as a 4-byte header and then sends the message as-is:

package communicator;

use 5.10.1;
use strict;
use warnings;

use IO::Socket::SSL;

sub connect {
my $self = shift @_;
my $server = shift @_;
my @field = split /\:/, $server;

my $socket;

$socket = IO::Socket::SSL->new(
'PeerAddr' => $field[0],
'PeerPort' => $field[1],
'Blocking' => 1,
);

if ( $socket ) {
binmode $socket;
}
else {
# error handling
};

$self->{'SOCK'} = $socket;
};

sub sendframe {
my $self = shift @_;
my $msg = shift @_;

if ($self->{'SOCK'}) {
my $length = pack("N", bytes($msg));
($self->{'SOCK'})->print($length);
($self->{'SOCK'})->print($msg);
};
};


This works when called from the command line, but fails when running as a
Net::Server
process. I have tried logging the content that is sent to the remote server, but the log files are identical for both approaches.

I have written a minimal SSL server to capture the content, and found out that when
Net::Server
is running, each print on a socket adds a newline to what is being sent. So the server receives

[packet length in binary]Line 1
Line 2
--- [Received announced length + 4 bytes]


on a direct call and

[packet length in binary]
Line 1
Line 2

--- [Received announced length + 6 bytes]


on a call with
Net::Server
running. Of course this breaks communication with the external server.

I suspect that
Net::Server
sets a global config variable in
IO::Socket::SSL
that confuses subsequent calls to
sendframe
, but I cannot figure out which variable it might be.

Note that I am using an external library to connect to other servers in addition to my own
communicator
class. That library also uses
IO::Socket::SSL
and suffers from the same issue, so I'd prefer to fix
IO::Socket::SSL
over using something other than
$socket->print
.

I would be able to patch the external library, but would likely have to do that every time there is an update.

My system is Debian 7 with Perl 5.14, IO::Socket::SSL 2.020 and Net::Server 2.006

Answer

print on an IO::Socket::SSL handle behaves like print on other file handles in that it respects the setting of $\. From perldoc perlvar:

  $\      The output record separator for the print operator.  
          If defined, this value is printed after the last of print's
          arguments.  Default is "undef".

Since this variable is undef by default there will only be changes if somebody sets this variable explicitly. I cannot see Net::Server set this variable anywhere. Maybe it's instead in your own code or other modules you use? In case you will not affect your other code you could localize the variable, i.e.

if ($self->{'SOCK'}) {
    local $\ = undef; ### make sure to disable side effects
    my $length = pack("N", bytes($msg));
    ($self->{'SOCK'})->print($length);
    ($self->{'SOCK'})->print($msg);
};