Script execution blocked when reading from a socket

[Mark]

Hello. I am attempting to write a simple program to scan ports to look for
Quake 3
servers. I adapted the code from the O'Reilly "Programming Perl" book.

The script is invoked with a starting and ending IP address and a port, as
follows:

perl q3_search.pl 207.210.230.5 207.210.230.10 27960

The script will usually scan a few addresses, and then it will hang.
The hangup occurs when attempting to read from the socket. This happens
whether
I treat the socket as a file handle (as in this example), or if I use the
recv() function.

Suggestions?

Thanks
-Mark

=======================================
#!/usr/bin/perl -w

# Q3_SEARCH.PL
#
# Based on "Programming Perl" p349

require 5.002;
use strict;
use Socket;
use Socket qwDEFAULT :crlf);

my ($ipfirst, $iplast, $remote, $port, $iaddr, $paddr, $proto, $line);

$ipfirst = shift;
if ($ipfirst !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {die "Invalid IP
address as param #1";}

$iplast = shift;
if ($iplast !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {die "Invalid IP
address as param #1";}
$port = shift || 27960; #Default Quake 3 Port

if ($port =~ /\D/) { $port = getserverbyname($port, 'udp')}
die "No port" unless $port;

$remote = $ipfirst;
my $exit_flag = 0;

while (1)
{
print "Testing $remote\.\.\.\n";
$iaddr = inet_aton($remote) or die "no host: $remote";

$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('udp');
socket(SOCK, PF_INET, SOCK_DGRAM, $proto) or die "socket: $~";
connect(SOCK, $paddr) or die "connect: $~";

# Setting autoflush is supposed to help prevent blocking
# when attempting to read from the socket. . .
my $oldh = select(SOCK);$|=1;select($oldh);$|=1;

defined(send SOCK, "\xff\xff\xff\xffgetstatus", 0) || goto NEXT_IP;

# Select() is supposed to succeed if the socket has data,
# or else timeout and return FALSE.
if (!(select (SOCK, undef, undef, 10.0))) {goto NEXT_IP;}

# Script will eventually hang on the following line
if (!defined($line = <SOCK>)) {goto NEXT_IP;}
if ($line =~ "statusResponse")
{print " $remote:$port is active\n";
}

close (SOCK) or die "close: $~";
if ($exit_flag > 0) {last;}

NEXT_IP:
$remote = inc_ip_addr($remote);
if ($remote eq $iplast) {$exit_flag = 1;}
}



sub inc_ip_addr
{
my $ipaddr = shift;
my $newip = "";

$ipaddr =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
my $a = $1;
my $b = $2;
my $c = $3;
my $d = $4;

$d++;
if ($d > 255) {$d = 0; $c++;} else {goto INC_IP_EXIT;}
if ($c > 255) {$c = 0; $b++;} else {goto INC_IP_EXIT;}
if ($b > 255) {$b = 0; $a++;} else {goto INC_IP_EXIT;}

INC_IP_EXIT:
$newip = $a . "\." . $b . "\." . $c . "\." . $d; return $newip;
}

 

[Anno Siegel]

Hello. I am attempting to write a simple program to scan ports to look for
Quake 3
servers. I adapted the code from the O'Reilly "Programming Perl" book.

The script is invoked with a starting and ending IP address and a port, as
follows:

perl q3_search.pl 207.210.230.5 207.210.230.10 27960

The script will usually scan a few addresses, and then it will hang.
The hangup occurs when attempting to read from the socket. This happens
whether
I treat the socket as a file handle (as in this example), or if I use the
recv() function.

Suggestions?

Thanks
-Mark

=======================================
#!/usr/bin/perl -w

# Q3_SEARCH.PL
#
# Based on "Programming Perl" p349

require 5.002;
use strict;
use Socket;
use Socket qwDEFAULT :crlf);

my ($ipfirst, $iplast, $remote, $port, $iaddr, $paddr, $proto, $line);

$ipfirst = shift;
if ($ipfirst !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {die "Invalid IP
address as param #1";}

$iplast = shift;
if ($iplast !~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {die "Invalid IP
address as param #1";}
$port = shift || 27960; #Default Quake 3 Port

if ($port =~ /\D/) { $port = getserverbyname($port, 'udp')}
die "No port" unless $port;

$remote = $ipfirst;
my $exit_flag = 0;

while (1)
{
print "Testing $remote\.\.\.\n";
$iaddr = inet_aton($remote) or die "no host: $remote";

$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('udp');
socket(SOCK, PF_INET, SOCK_DGRAM, $proto) or die "socket: $~";
connect(SOCK, $paddr) or die "connect: $~";

# Setting autoflush is supposed to help prevent blocking
# when attempting to read from the socket. . .
my $oldh = select(SOCK);$|=1;select($oldh);$|=1;

defined(send SOCK, "\xff\xff\xff\xffgetstatus", 0) || goto NEXT_IP;

# Select() is supposed to succeed if the socket has data,
# or else timeout and return FALSE.
if (!(select (SOCK, undef, undef, 10.0))) {goto NEXT_IP;}

Select guarantees that at least on character is available. You
are trying to read an entire line. Try reading a single character.

# Script will eventually hang on the following line
if (!defined($line = <SOCK>)) {goto NEXT_IP;}
if ($line =~ "statusResponse")
{print " $remote:$port is active\n";
}

close (SOCK) or die "close: $~";
if ($exit_flag > 0) {last;}

[snip]

Anno

 

[Anno Siegel]

Is this what you are suggesting?

if (!recv(SOCK, $line, 1, 0)) {goto NEXT_IP;}

It is, or rather, it was before I noticed you are not using select() right.
In particular, the first argument isn't a filehandle but a bit vector of
file numbers. See perldoc -f select. The standard module IO::Select takes
care of the technicalities.

I tried this, but my script still hangs up on the same IP
addresses that caused problems before.

Well, so far you have been relying on random results from select().
Try the real thing.

Anno

 

[Mark]

It is, or rather, it was before I noticed you are not using select()
right.

On second thought, select() isn't going to work under Windows, is it?

 

[Anno Siegel]

On second thought, select() isn't going to work under Windows, is it?

I don't know. The documentation says nothing about the possibility of
select() being unimplemented. It usually does.

There are, however, two warnings that may be pertinent, one about
select() with sockets and one about select() with buffered IO.

Anno

 

[xhoster]

# Setting autoflush is supposed to help prevent blocking
# when attempting to read from the socket. . .

Setting autoflush is only relevent for handles you write to. It has
no effect on reading.

my $oldh = select(SOCK);$|=1;select($oldh);$|=1;

SOCK->autoflush(1); # more readable

Also, you should use lexical file handles.

# Select() is supposed to succeed if the socket has data,
# or else timeout and return FALSE.
if (!(select (SOCK, undef, undef, 10.0))) {goto NEXT_IP;}

Hmm... perldoc -f select. Nope, it doesn't do what you seem to think
it does.

# Script will eventually hang on the following line
if (!defined($line = <SOCK>)) {goto NEXT_IP;}

select, if used properly, tells you you have something to read. It doesn't
say that that thing waiting to be read is an entire line.

Xho

 

[Anno Siegel]

Setting autoflush is only relevent for handles you write to. It has
no effect on reading.


SOCK->autoflush(1); # more readable

Also, you should use lexical file handles.

Yikes, that works with a plain old package filehandle? I hadn't noticed.

Anno

[snip]

 

[Mark]

Yikes, that works with a plain old package filehandle? I hadn't noticed.

Someday, when I'm a grownup, I'll understand what you're discussing here.

-Mark

 

[Rocco Caputo]

On second thought, select() isn't going to work under Windows, is it?

You're in luck. ActiveState's Perl implements select() for sockets,
although not for other types of filehandle. Cygwin is another option
for Windows, and it implements a more complete select().

 

[Mark]

You're in luck. ActiveState's Perl implements select() for sockets,
although not for other types of filehandle. Cygwin is another option
for Windows, and it implements a more complete select().

And through some great stroke of luck, I'm using ActiveState Perl!