IO::Socket::INET -- use read or recv? 2

[codelady7]

Hi to any and all --

I'm trying to build a script to listen on a port, accept an incoming connection, and write the incoming data to a file. I've seen some examples, but am confused by using read or recv. I've also seen something like:
...
while ($new_sock = $sock->accept()) {
while (defined ($buf = <$new_sock>)) {
print $buf; #I would write to output file here
}
}

Is there a "best" way to do this? I want to accept the connection, write data, then go back to listening for another connection.

Thanks in advance!!

Chris Hawkins

 

[cdlvj]

This does it, handles multiple clients at a time.
You have to have a mechanism to punt the reads to another
process and go back to listening.

my $socket;
my $port = 9000;
my $host;

use IO::Socket;
use Sys::Hostname;

$SIG{CHLD} = sub {wait ()};

$host = hostname();

# START LOOP HERE
my $main_sock = new IO::Socket::INET (LocalHost => $host,
                                   LocalPort => $port,
                                   Listen    => 5,
                                   Proto     => 'tcp',
                                   Reuse     => 1,
                                  );
if (!$main_sock)
    {
     die "Socket could not be created. Reason: $!\n";
}

my $buf;
my $new_sock;
my $pid;
while ($new_sock = $main_sock->accept()) {
    $pid = fork();
    if ($pid == 0) { 
        # Child process
        while (defined ($buf = <$new_sock>)) 
        {
           # do something with $buf ....
          my @lines = split(/\|/,$buf);
        exit(0);   # Child process exits when it is done.
    } # else 'tis the parent process, which goes back to accept()
}
close ($main_sock);
exit;

 

[codelady7]

Thanks for the script... perl complains that it's missing a curly brace... after the @lines, maybe? At any rate, on my system, this script (and others like it from the Advanced Perl Programming book, CH 12), hangs on the

while ($new_sock = $main_sock->accept()) {

line. Last few lines of debug trace show:

IO::Socket::new(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:46):
46: ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
IO::Socket::new(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:48):
48: return scalar(%arg) ? $sock->configure(\%arg)
49:: $sock;
IO::Socket::accept(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:169
):
169: my $peer = undef;
IO::Socket::accept(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:171
):
171: if(defined $timeout) {
IO::Socket::accept(/usr/lib/perl5/5.8.0/i386-linux-thread-multi/IO/Socket.pm:183
):
183: $peer = accept($new,$sock)
184r return;

And there it sits... not sure what to try next ?!

Thanks,
Chris

 

[Kozusnik]

I like cdlvj's code. I'll save that for later...Here's the code I've used for a while. Just remove the print statements and wrap your output file in here...

#!/usr/bin/perl
use IO::Socket;

$local = IO::Socket::INET->new(
Proto => 'tcp',
LocalAddr => 'localhost:78999',
Reuse => 1
) or die "$!";

$local->listen();
$local->autoflush(1);

print "At your service. Waiting...\n";

my $addr;

while ($addr = $local->accept() ) {
print "Connected from: ",$addr->peerhost();# Display messages
print " Port: ", $addr->peerport(), "\n";

my $result;
while (<$addr>) {
last if m/^end/gi;
print "Received: $_";
print $addr $_;
$result += $_;
}

chomp;
if (m/^end/gi) {
my $send = "result=$result";
print $addr "$send\n";
print "Result: $send\n";
}
print "Closed connection\n";

close $addr;
print "At your service. Waiting...\n";
}

SELECT * FROM management WHERE clue > 1
> 0 rows returned

--ThinkGeek T-Shrit

 

[Kozusnik]

I should have added the client side also. You can start the server, then run the client. Type a message, hit enter, and the server will display it.

#!/usr/bin/perl
use IO::Socket;
$remote = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr=> 'localhost',
PeerPort=> "78999",
Reuse => 1,
) or die "$!";
#print "Connected to ", $remote->peerhost, " on port: ", $remote->peerport, "\n";
$remote->autoflush(1);
while (<>) {
print $remote $_;

last if m/^end/gi;
my $line = <$remote>;
if ($line ne $_) {
print "Error in sending output\n";
exit;
}
}
my $res = <$remote>;
$res =~ m/result=(\d*)/gi;
print "Result: $1\n";
print "End of client\n";
close $remote;

I guess it depends on what you're using this for.
Mark

SELECT * FROM management WHERE clue > 1
> 0 rows returned

--ThinkGeek T-Shrit

 

[codelady7]

Thanks for everyone's help. I'm making "some" progress...I'm doing this on a redhat box. Wrote one script for server (as per your examples), and wrote another for sender. I can see, when running both scripts on same box, that messages show up. So I have to guess that the problem is the other sender I'm trying to use on my XP machine. It's a java pgm called hl7comm.jar. I've had some luck using hl7comm.jar to send to my redhat box using a downloaded script (hl7srvr.pl) I found, but not with these OOP ones. Not sure why the hl7srvr.pl script accepts a message when the above scripts don't. Back to the drawing board! Thanks again all --

-- C.

 

[cdlvj]

Missing the bracket in the child logic.

while ($new_sock = $main_sock->accept()) {
    $pid = fork();
    if ($pid == 0) { 
        # Child process
        while (defined ($buf = <$new_sock>)) 
        {
           # do something with $buf ....
          my @lines = split(/\|/,$buf);
        exit(0);   # Child process exits when it is done.

     [B]}   missing bracket here sorry [/b]

    } # else 'tis the parent process, which goes back to accept()
}
close ($main_sock);
exit;

 

[cdlvj]

Some of this stuff may be old release's and will not work properly. I have trying to set up my server as a service using ActivePerl, and when the child finishes, the server aborts. Downloaded a new version of activePerl, and it works fine.

 

[Kozusnik]

I didn't know this was for HL7. I have scripts for that too. I haven't written the ack yet, but it's relatively simple.

Could that be the problem? It's not sending the ack to the external interface, so the external hangs.

I can't find the code, it must be at work. I'll see if I can find it.

Mark

SELECT * FROM management WHERE clue > 1
> 0 rows returned

--ThinkGeek T-Shrit

 

[codelady7]

Yup...hl7. I have had a "dumb-as-a-post" perl script in place for some time now that just opens a socket, sends a message, then closes. Doesn't bother to wait for an ack, etc. I need to receive messages, now, and send acks... so figured I'd look around for established scripts rather than write my own. I also found a java program, hl7comm.jar, that seems to work just fine. I've been trying two 'flavors' of scripts... The excerpt below is from hl7srvr.pl, courtesy of Bob Dilworth in Toledo, OH, and was the reason I initially posted here. My system returns info in $line as a result of the recv function, but it ALSO takes the or $x=1 branch, which puzzles me.
....#other init stuff comes before this.....
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))
{
recv(Client,$line,$rcvsize,0) or $x = 1;

The other thing I'm not sure about, given my limited Perl knowledge, is how this script compares to the samples you've all provided, that use the OOP-ish approach...

At present, I'm upgrading my perl to 5.8.8. Then I'll try both scripts again, and report back. Oh BTW, the "hang" I was reporting was stupid programmer tricks... I had the trace on, and it was waiting patiently for some incoming traffic. Looks like my Perl install is done -- wish me luck!

Chris