socket help with long text blocks 1

[codelady7]

Hi --

I am testing perl scripts to send/receive. The receiver runs on linux. I have an identical sender script that I invoke either on the same linux box, or on a windows XP box. If the file I'm sending contains a long-ish block of text (more than about 2K), the linux -> linux transfer seems fine, but the windows -> linux transfer ends up short. If I examine the two files received on the linux side, I see that the windows file has had a few characters snipped at about byte 1258, and a $0A$ put in their place.

For example:
linux snippet: the free ($20746865206672656520$) hex
windows snippet: the
e ($20746865200A6520$) hex

In the windows file, the first three characters of the word "free" have been replaced by $0A$. How can I prevent this from happening??

Thanks in advance to anyone who can help!!

p.s. Here is the sender script:
******************************************************
# sender
# a simple client using IO:Socket
#----------------

use strict;
use IO::Socket;
my $infile = @ARGV[0];
my $sock;
my $HL7 = <>;
my $wbytes;
my $rbytes = 5120;
my $ackback = "no ack received.";

open LOGFILE, ">>hl7.log";

my $sock = new IO::Socket::INET (PeerAddr => '192.168.1.210', PeerPort => 10500, Proto => 'tcp');
$sock or die "no socket :$!";
#print "socket created...\n";

$wbytes = send ($sock, "\013".$HL7."\034\015", 0);
print "$wbytes sent.\n";
recv ($sock, $ackback, $rbytes, 0);

print LOGFILE ("File sent: " . $infile . ".\n");
print LOGFILE ("Bytes sent: " . $wbytes . ".\n");
print LOGFILE ("Received ack: " . $ackback . ".\n");

close LOGFILE;
close ($sock);

 

[Kirsle]

Can we see the receiver script too? From my experience with IO::Socket servers, the recv command took a "number of bytes" parameter for how much of the message to receive from the client.

So posting the receiving code might help too.

 

[codelady7]

The server is courtesy Bob Dilworth in Toledo, Ohio... below is the meat and potatoes of it (left out subroutines to build a reply message). The receive size has been set to 5120, so it isn't just a case of truncation. And it works fine when linux is doing the sending. But if perl running on my XP box executes the same sender script, the text received has been "surgically altered" as described...

Sender:
#
# Author: Bob Dilworth
# Medical College of Ohio, Toledo, Ohio
# (419)383-6071
# bdilworth@mco.edu
#
# Call as: perl hl7srvr.pl <socket> <eater file> <bytes to read from socket>
# Defaults: <socket> 9666 <eater file> recv.dat <bytes to read from socket> 5120
#
use Socket;
use Time::localtime;
#
my $port = shift || 10500;
my $efile = shift || "recv.dat";
my $rcvsize = shift || 5120;
my $proto = getprotobyname('tcp');
my $paddr;
my $rin;
my $rout;
my $win;
my $wout;
my $ein;
my $theone;
my $flag = 0;
my $ltm;
my $tyme;
my $msg;
my $x;
my $sob = chr(11);
my $eob = chr(28);
my $outline;
#
open(eater, "> $efile") or die "Cannot open the eater file\n";
socket(Server, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) or die "bind: $!\n";
listen(Server,SOMAXCONN) or die "listen: $!\n";
#
print "Server started on port $port\n";
#
for (;
{
print "Server listening on port $port for a new connection ...\n";
$paddr = accept(Client, Server);
my($port, $iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
$rin = $win = $ein = "";
vec($rin, fileno(Client), 1) = 1;
vec($win, fileno(Client), 1) = 1;
$ein = $rin | $win;
print "connection from $name [", inet_ntoa($iaddr), "] at port $port\n";
while (1)
{
$x = 0;
$theone = select($rout=$rin, undef,undef,undef);
if (vec($rout,fileno(Client),1))
{
$x = recv(Client,$line,$rcvsize,0);
if ($line eq "")
{
print "connection from $name [",
inet_ntoa($iaddr), "] at port $port has been closed!\n";
close (Client);
last;
}
if ($x == 0)
{
chomp $line;
$ltm = localtime;
$tyme = sprintf("%02d/%02d/%04d:%02d:%02d:%02d",$ltm->mon+1,$ltm->mday,$ltm->year+1900,$ltm->hour,$ltm->min,$ltm->sec);
print "$tyme Received data from $name [", inet_ntoa($iaddr), "] on port $port\n";
$flag = 1;
}
else
{
print "connection from $name [",
inet_ntoa($iaddr), "] at port $port has been closed!\n";
close (Client);
last;
}
}
if ($flag == 1)
{
$theone = select(undef,$wout=$win, undef,undef);
if (vec($wout,fileno(Client),1))
{
print "Sending response to $name [", inet_ntoa($iaddr), "] on port $port\n";
my $line2 = build_response(substr($line,1));
$outline = substr($line,1,-2) . chr(10);
my $x = syswrite(eater,$outline,length($outline));
print "Wrote $x characters to $efile\n";
$line2 = $sob . $line2 . "\r" . $eob . "\r";
send(Client,$line2,0);
}
$flag = 0;
}
}
}

 

[cdlvj]

The maximum size is set by the MTU of the nic. Recalled that setting this up on a AIX box, there was a function to stat the connection so that the recv was put in a loop until all the bytes were read. Normal physical size of MTU is around 1500 bytes.

I would think that the socket module would take care of this, but have not seen any evidence or examples of it.

 

[codelady7]

I was thinking along the same lines (about MTU, I mean). Did some sending from XP to linux with Ethereal capturing. I can see that, for a message of size 3316, it sends 1260, then 1260, then 796. Using the receive script below, it only ever records the first 1260. Using the script above -- and I assume his use of the select function makes his script work better -- I get more of the message, but it's still malformed by those couple of bytes in the middle. Let's assume I can figure out a loop or some such to be sure all the packets are delivered -- can anyone tell me if the script below is just way too simple, or should it work? Do I need to wait in between the receive and send? Do I need to add a select function on the socket to be sure I'm not sending while the other end is still receiving?

Thanks to all who are helping -- I very much appreciate the input!

Script**************************************
# server using IO::Socket
#---------------------
use strict;
use IO::Socket;
open MSGFILE, ">>msgs.dat";
my $sock = new IO::Socket::INET(
LocalHost => '192.168.1.210',
LocalPort => 10500,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);

$sock or die "no socket :$!";
my($new_sock, $c_addr, $buf);
print "listening...\n";
while (($new_sock, $c_addr) = $sock->accept())
{
my ($client_port, $c_ip) =sockaddr_in($c_addr);
my $client_ipnum = inet_ntoa($c_ip);
my $client_host =gethostbyaddr($c_ip, AF_INET);
print "got a connection from: $client_host"," [$client_ipnum] ";
my $bytesin = 5120;
recv($new_sock, $buf, $bytesin, 0);
print "length is: ". length($buf). "\n";
print "bytes in is: $bytesin\n";
$buf = substr($buf,1,-2).chr(10);
syswrite (MSGFILE, $buf, length($buf));
send ($new_sock, "buf: ".$buf."...got it, thanks. \n",0);
}
close MSGFILE;
close $sock;

 

[codelady7]

Hello to all --

I think I have it working -- I took your suggestion, cdlvj, and put the recv function in a loop until the data received contains the end-of-message characters that are standard for HL7 (script is below). I added a print statement in the loop, so it says "looping...." each time through. If I send from linux to linux, from XP to XP, or from linux to XP, it only shows "looping..." once. But, going from XP to linux, it will show "looping..." two or three times, depending on message size.

If this seems wrong-headed to anyone, please holler!

And many thanks to all who helped --

-- Chris

# server using IO::Socket
#---------------------
use strict;
use IO::Socket;
open MSGFILE, ">>msgs.dat";
my $sock = new IO::Socket::INET(
LocalHost => '192.168.1.103',
LocalPort => 10500,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);

$sock or die "no socket :$!";
my($new_sock, $c_addr, $buf, $bigbuf, $i);
print "listening...\n";
while (($new_sock, $c_addr) = $sock->accept())
{
my ($client_port, $c_ip) =sockaddr_in($c_addr);
my $client_ipnum = inet_ntoa($c_ip);
my $client_host =gethostbyaddr($c_ip, AF_INET);
print "got a connection from: $client_host"," [$client_ipnum] ";
my $bytesin = 5120;
$bigbuf = "";
while (index($buf,"\034\015") == -1) {
recv($new_sock, $buf, $bytesin, 0);
$bigbuf .= $buf;
print "looping...\n";
}
print "length is: ". length($bigbuf). "\n";
print "bytes in is: $bytesin\n";
$bigbuf = substr($bigbuf,1,-2).chr(10);
syswrite (MSGFILE, $bigbuf, length($bigbuf));
send ($new_sock, "buf: ".$bigbuf."...got it, thanks. \n",0);
($buf, $bigbuf) = "";
}
close MSGFILE;
close $sock;