TCP client/server speaking proprietary protocol

[travislspencer]

Hey All,

I am trying to write a little TCP server. The format of the protocol
it and its clients speak is a proprietary one. The data isn't line
oriented in any way; however, most of the examples I've seen delimited
requests and responses using a new line as in the reader sub described
on http://tinyurl.com/z7b7r.

My question is this: how can I write a TCP server that will accept
exactly the amount of data sent to it from its client. At first, my
server wasn't accepting all of the clients packets. I fixed this by
using the IO::Select module; however, now it reads too much. At the
moment, this is the server:

#!/usr/bin/perl

use strict;
use warnings;
use IO::Select;
use IO::Socket;

my $server = IO::Socket::INET->new(LocalPort => 7142,
Type => SOCK_STREAM,
Reuse => 1,
Listen => SOMAXCONN)
|| die "Couldn't act as a TCP server on $port: $@\n";
my $select = IO::Select->new();

while (my $client = $server->accept()) {
$select->add($client);

while ($select->can_read()) {
my $buf;
my %packet;

$client->sysread($buf, 5);

$packet{command} = unpack("n", $buf);
$packet{product_id} = unpack("xxC", $buf);
$packet{model_code} = unpack("xxxC", $buf) >> 4;
$packet{data_length} = unpack("xxxn", $buf) & 0xFFF;

$client->sysread($buf, $packet{data_length});
# TODO: Put the data into the packet structure.

$client->sysread($buf, 1);
$packet{checksum} = unpack("C", $buf);

# Do work w/ %packet lick verifying its checksum,
# responding to its command, etc.
}

$select->remove($client);
}

close($server);

I am trying to test it with this client:

#!/usr/bin/perl

use strict;
use warnings;
use IO::Socket;
use IO::Select;

my $host = "127.0.0.1";
my $socket = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => 7142,
Type => SOCK_STREAM)
|| die "Couldn't connect to $host:$port: $@\n";

print $socket pack("C7",
0xcc, # Command ID 1
0x81, # Command ID 2
0xF, # Product ID
0xF0, # Model code & high 4 bits of length
1, # Low 8 bits of data length
0x76, # data
0x44 # Checksum
);
print $socket pack("C7",
0xcc,
0x81,
0xF,
0xF0,
1,
0x76,
0x44
);

close($socket);

The server starts fine; however, when I run the client, I get this
error:

'x' outside of string in unpack at ./pseudopd line 34.

This happens after the server reads both packets that the client sent
to it. Line 34 is this one:

$packet{product_id} = unpack("xxC", $buf);

I have poured over the server code for too long and surfed around the
Net. I'm starting to think that the client is broken, but I wanted to
ask if anyone could spot my mistake. I'm really new to this stuff, so
I would really appreciate a hand.

 

[xhoster]

Hey All,

I am trying to write a little TCP server. The format of the protocol
it and its clients speak is a proprietary one. The data isn't line
oriented in any way; however, most of the examples I've seen delimited
requests and responses using a new line as in the reader sub described
on http://tinyurl.com/z7b7r.

I'm not sure what you mean by this. I don't seen any evidence of this
newline in the code that you provided.

My question is this: how can I write a TCP server that will accept
exactly the amount of data sent to it from its client. At first, my
server wasn't accepting all of the clients packets. I fixed this by
using the IO::Select module;

I don't see how you used IO::Select to fix this problem. IO::Select
is to prevent either blocking or tight-loop polling, or to let you find
the first of many readable handles. I don't see how any of them apply.

BTW, your server code fails to compile as posted. $port is not declared.

while (my $client = $server->accept()) {
$select->add($client);

while ($select->can_read()) {

One generally captures the return of can_read. Because you only ever have
one handle in IO::Select at a time, you can get away with this, but it is
still rather weird to my eyes. Why use IO::Select at all if there is only
one thing to select and you want to block on it anyway?

my $buf;
my %packet;

$client->sysread($buf, 5);

Just because you asked for 5 bytes doesn't mean you got 5 bytes.
You need to check either for zero bytes or for some other number of bytes
less than 5.

Alternatively, you could get rid of the IO::Select and use read rather than
sysread. Then you would only have to check for 0 bytes (eof) or 5 bytes
(good data)

....

# Do work w/ %packet lick verifying its checksum,
# responding to its command, etc.
}

$select->remove($client);

The only time can_read will return false (and thus the loop will exit) is
when the file handle is open, but not readable at the moment (which should
never actually happen, because you are using a blocking can_read). Why do
you want to remove a still-open handle?

Xho

 

[travislspencer]

I don't see how you used IO::Select to fix this problem. IO::Select
is to prevent either blocking or tight-loop polling, or to let you find
the first of many readable handles. I don't see how any of them apply.

Thank you, Xho, for clearifying this for me. I appreciate it

BTW, your server code fails to compile as posted. $port is not declared.

I snipped the declaration of $port to cut out a line of code and make
the example smaller. My bad.

Why use IO::Select at all if there is only
one thing to select and you want to block on it anyway?

Yes, why indeed. Honestly, because A) I knew no better and B) because
all of the examples I could find used it. Thanks for the explination
of Select.

Alternatively, you could get rid of the IO::Select and use read rather than
sysread. Then you would only have to check for 0 bytes (eof) or 5 bytes
(good data)

This is exactly what I've done and it works. Here is my code ATM:

#!/usr/bin/perl

use strict;
use warnings;
use IO::Socket;

my $port = 8080;
my $server = IO::Socket::INET->new(LocalPort => $port,
Type => SOCK_STREAM,
Reuse => 1,
Listen => SOMAXCONN)
|| die "Couldn't act as a TCP server on $port: $@\n";

while (my $client = $server->accept()) {
until(eof($client)) {
my $buf;
my %packet;

$client->read($buf, 5);

$packet{command} = unpack("n", $buf);
$packet{product_id} = unpack("xxC", $buf);
$packet{model_code} = unpack("xxxC", $buf) >> 4;
$packet{data_length} = unpack("xxxn", $buf) & 0xFFF;

$client->read($buf, $packet{data_length});
# XXX: put buf into data
$packet{data} = "";

$client->read($buf, 1);
$packet{checksum} = unpack("C", $buf);
}
}

Thanks again, Xho!

 

[Ben Morrow]

Quoth (e-mail address removed):

This is exactly what I've done and it works. Here is my code ATM:

No you haven't. Nowhere below do you check the return value of read().
If it seems to work ATM that is only chance.

#!/usr/bin/perl

use strict;
use warnings;
use IO::Socket;

my $port = 8080;
my $server = IO::Socket::INET->new(LocalPort => $port,
Type => SOCK_STREAM,
Reuse => 1,
Listen => SOMAXCONN)
|| die "Couldn't act as a TCP server on $port: $@\n";

while (my $client = $server->accept()) {
until(eof($client)) {

In general it is worth avoiding eof(). It is much easier to simply wait
for a return of 0 from read (which you have to check for anyway).

my $buf;
my %packet;

I wouldn't declare this here. I would declare it below...

$client->read($buf, 5);

You need to check, here, what read returned. If it returned 0, you are
at EOF. If it returned undef, there was an error, in which case you need
to check $! and deal with it. Note that some errors (EINTR, on some
machines under some circumstances; see your system documentation for
fread(3) and read(2)) are not in fact fatal errors and just require you
to retry the read. If it returned 5, you are happy. If it returned >0
but <5, you need to read some more into the end of $buf.

Yes, this interface stinks. Don't blame Perl, blame Unix: Perl's just
copying the standard system interface.

$packet{command} = unpack("n", $buf);
$packet{product_id} = unpack("xxC", $buf);
$packet{model_code} = unpack("xxxC", $buf) >> 4;
$packet{data_length} = unpack("xxxn", $buf) & 0xFFF;

....here, like

my %packet = (
command => (unpack n => $buf),
product_id => (unpack xxC => $buf),
...
);

(that form of parenthesising is just what I prefer; you may be happier
with unpack(n => $buf), which is also fine.)

$client->read($buf, $packet{data_length});

All of the above applies to this read as well, and the one below.

Ben

 

[xhoster]

Quoth (e-mail address removed):

No you haven't. Nowhere below do you check the return value of read().
If it seems to work ATM that is only chance.

While not the way I would do it, I think his method is working on principle
and not only on chance.

In general it is worth avoiding eof(). It is much easier to simply wait
for a return of 0 from read (which you have to check for anyway).


You need to check, here, what read returned. If it returned 0, you are
at EOF.

In which case you wouldn't be here in the first place, because eof would
have returned true.

If it returned undef, there was an error, in which case you need
to check $! and deal with it.

That is the main weakness of his code. An error could trigger eof
to return true, which he would silently miss, assuming it was truly
eof. Whether that is a problem depends on what exactly he is doing.

Note that some errors (EINTR, on some
machines under some circumstances; see your system documentation for
fread(3) and read(2)) are not in fact fatal errors and just require you
to retry the read. If it returned 5, you are happy. If it returned >0
but <5, you need to read some more into the end of $buf.

Are you sure this is the case with Perl's read? I thought Perl's read
automatically restarted for you if needed. I've seen sysread of course
come back early with EINTR, and also accept, but never read.

Xho

 

[Eric Schwartz]

In which case you wouldn't be here in the first place, because eof would
have returned true.

Are you sure? I'm pretty sure I've programmed in environments where
eof() didn't return true until a read() was attempted. It's been a
long time, though, so maybe I am imagining it.

-=Eric

 

[Ben Morrow]

Quoth (e-mail address removed):

That is the main weakness of his code. An error could trigger eof
to return true, which he would silently miss, assuming it was truly
eof. Whether that is a problem depends on what exactly he is doing.


Are you sure this is the case with Perl's read? I thought Perl's read
automatically restarted for you if needed. I've seen sysread of course
come back early with EINTR, and also accept, but never read.

My system's fread(3) says it can come back early in case of error... I
admit I don't know if there are any non-fatal errors it might come back
with, but I would consider it good practice to code for them in case .
There is also a chance of deadlock (I think?) with fread(3) in a
protocol conversation (because it is trying to read a whole buffer
rather than just what you asked for): I would always use sysread
(read(2)). But you may be right that it is safe: I admit my knowledge is
a little sketchy here.

Ben

 

[Rocco Caputo]

My question is this: how can I write a TCP server that will accept
exactly the amount of data sent to it from its client. At first, my
server wasn't accepting all of the clients packets. I fixed this by
using the IO::Select module; however, now it reads too much.

Generally you can't rely on reading exactly the amount of data you
need. Instead, read as much is available, append to a framing buffer,
and then parse and remove data from the buffer when it has accumulated
enough.

Extra data remains in the framing buffer so that subsequent sysreads
will complete the next packet.

Also be sure to binmode() your sockets if you're using a non-Unix
machine anywhere in this project. You may also want to C<use bytes>
around code that relies on octet counts rather than character counts.

See various POE::Filter classes on the CPAN for examples of this
pattern.

 

[Ben Morrow]

Quoth (e-mail address removed) (Rocco Caputo):

Also be sure to binmode() your sockets if you're using a non-Unix
machine anywhere in this project.

s/if you're.*project//;

All perls need binmode where appropriate since 5.8.

You may also want to C<use bytes>
around code that relies on octet counts rather than character counts.

If your data is 8-bit binary data this shouldn't be necessary (this was
one of the design goals for 5.8's Unicode support).

Ben

 

[Randal L. Schwartz]

Ben> All perls need binmode where appropriate since 5.8.

Do you have a reference for this, or an explanation? This is the first
I've heard of this.

--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[email protected]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

*** ***

 

[Ben Morrow]

Quoth (e-mail address removed) (Randal L. Schwartz):

Ben> All perls need binmode where appropriate since 5.8.

Do you have a reference for this, or an explanation? This is the first
I've heard of this.

perldoc -f binmode, third paragraph.

Since Perl's IO is Unicode-based, now, it is necessary to state which
files are binary (and indeed state the encoding for text files). In
particular, 5.8.0 in a UTF8 locale, and later versions with a -C switch
or appropriate open pragma, will attempt to read and write all data as
UTF8 by default.

OK, if you are using 5.8.>0 and you are absoultely *certain* your
strings will never get UTF8-marked, you can omit the binmode. It's not
very safe, though.

Ben