Pierce, Glen wrote:
> Hi All,
>
> I am hoping someone here can help me. First I will say I don’t have a
> lot of experience setting up socket connections. I am trying to set up
> a socket connection using IO::Socket. I want to establish a socket
> connection and keep it established. Can this be done? If so, what is
> the best way to do it? Also, is there a way to test to see if there is
> a socket connection already open on a certain port, other than netstat?
> Something internal to perl or the module itself is what I was looking
> for. Below is the snipet of code I am using.
...
As far as testing for another socket being open, you shouldn't be able to
make a connection to a pair of sockets if one exists already, so you could
try adding a LocalAddr/Host and LocalPort and you'll get an error back if
that port is in use already to the remote port.
Here's a rough example of a client type socket - the server would do a listen
(add 'Listen => 5, Reuse => 1' to new) and when the socket is ready from the
select, do a $listen->accept (I'd use $listen for the listen socket to keep it
apart from the connection socket - $socket). A ready on a can_read select on
a listen socket needs to accept and on a regular socket you want to read.
#!perl --
use strict;
use warnings;
use IO::Select;
use IO::Socket;
my $debug = 0;
my $host = 'localhost';
my $port = 8000;
my $protocol = 'tcp';
my $sel_set = new IO::Select();
my $socket;
my $rbuf;
my $wbuf;
while (1) {
if (not defined $socket) {
$socket = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port, Proto => $protocol) or do {
warn "new socket $host:$port: $! ($^E)" if $debug;
sleep 1; # try again after waiting a bit
next;
};
$sel_set->add($socket);
}
my @ready = $sel_set->can_read(0);
foreach (@ready) {
$rbuf = '';
my $len = 4096; # max read
my $off = 0;
my $res = read_data ($_, \$rbuf, $len, $off);
if ($res == -1) { # error
close_socket ();
} elsif ($res == 0) { # EOF
close_socket ();
} else {
# process data - check length received etc
# may need to get more data before processing
}
}
@ready = $sel_set->can_write(0);
foreach (@ready) {
$wbuf = 'some data from somewhere'; # unless partial buffer
# to write still avail
my $len = length $wbuf;
my $off = 0;
my $res = write_data ($_, \$wbuf, $len, $off);
if ($res == -1) { # error
close_socket ();
} elsif ($res == 0) { # EOF
close_socket ();
} else {
if ($res != $len) {
# part of data written
# will need to write again for rest
} else {
# create some new data
}
}
}
}
exit; # never get here
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub close_socket {
$sel_set->remove($socket);
$socket->close;
undef $socket; # force a new socket to be created
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub read_data {
my ($socket, $bufref, $len, $off) = @_;
my $bytes = sysread $socket, $$bufref, $len, $off;
if (not defined $bytes or $bytes < 0) { # read error
return -1;
} elsif ($bytes == 0) { # eof
return 0;
}
return $bytes; # return data length
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub write_data {
my ($socket, $bufref, $len, $off) = @_;
my $bytes = syswrite $socket, $$bufref, $len, $off;
if (not defined $bytes or $bytes < 0) { # write error
return -1;
} elsif ($bytes == 0) { # eof
return 0;
}
return $bytes; # return length of data written
}
__END__
_______________________________________________
Perl-Unix-Users mailing list
Perl-Unix-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
