Help improving IO::Socket script response

Hi all;

I'm not sure where/what I've gone wrong here; The purpose of the code
below is to get the server type (Apache/IIS/etc) from a list of URLs.
In the SQL query (whose results are used in the IO::Socket call), the
data from 'cname' will be a string, like "Foo Internet", the data from
'mainurl' will be a url like "www.foo.com"

The problem lies in massive time-outs (I don't know what the longest
is/can be: I've killed the process after ten minutes, however); The only
sanity-saving option so far is to run it in batches of ten URLs, but I've
got a list of ~400 to go through.

I've googled for somehow using a timeout with IO::Socket, but all the
responses seem to be that timeout is deprecated and only applies to the
handshake, not the listen/read. I'd be *really* happy if I could simply
get this to work with giving each url 5 seconds to respond with the first
8 lines to get the Server: header.

I've trimmed my code to get rid of all the HTML output for legibility's
sake; The reason for this little script is merely curiosity; A thread in
can.internet.highspeed was asking what OS the majority of ISPs in Canada
are running, so I thought I'd take a crack at it.

Many thanks for any provided insights or suggested reading! (I've gone
over the CPAN entries for IO::Socket and IO::Socket::INET several times,
but don't seem to be absorbing what it is that's causeing the timeouts)

#!/usr/bin/perl
use CGI;
use IO::Socket;
use URI::Escape;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use strict;

my $row;
my $keys;
my $key;
my $sock;
my %hosts;
my $hosts;
my $host;
my $dbname;
my $dbuser;
my $dbpass;
my @row;
my $foo;
my $line;
my $count;
my $found;
Define();

my $query="SELECT `cname`,`mainurl` FROM `ispdata` WHERE `mainurl` IS NOT
NULL AND `mainurl` != \"http://\"; AND `approved` = 1 ORDER BY `cname`";
my $dbh;
my $sth;
$dbh = DBI->connect("DBI:mysql:$dbname", $dbuser, $dbpass,{PrintError =>
1, RaiseError => 1});
$sth=$dbh->prepare($query);
$sth->execute();
while (@row=$sth->fetchrow()) {
$row[0]=uri_unescape($row[0]);
$row[1]=uri_unescape($row[1]);
$foo='http://';
$row[1]=~ s/$foo//g;
my @url;
if ($row[1] =~ /\//) {
@url=split /\//,$row[1];
$row[1]=$url[0];
}
$row[1]=~ s/ //g;
$hosts{$row[0]}=$row[1];
}
$sth->finish;
$dbh->disconnect;


LOOP: foreach $key (sort keys %hosts) {
next if ($hosts{$key} =~ /zeuter/);
print "\t$key\t$hosts{$key}\t";

my @Header;
$host = $hosts{$key};
$sock = IO::Socket::INET->new(PeerAddr => "$host",
PeerPort => 'http(80)',
Timeout => "5",
Reuse => "1",
Proto => 'tcp');

print $sock "GET / HTTP/1.0\n\n";
$found=0;
$count=0;
while(<$sock>) {
$line = $_;
++$count;
if ($line =~ /^Server/) {
print "$line\t\n";
$found=1;
last;
}
if ($count >10) {
print "NO RESPONSE\t\n";
next LOOP;
}
}
if ($found==0) {
print "\t\n";
next LOOP;
}
}
exit;

sub Define {
$dbname='xxx';
$dbuser='xxx';
$dbpass='xxx';
}
exit;

--
Marc Bissonnette
Looking for a new ISP? http://www.canadianisp.com
Largest ISP comparison site across Canada.
.

Relevant Pages

  • Re: Help improving IO::Socket script response
    ... I'm not sure where/what I've gone wrong here; The purpose of the code below is to get the server type from a list of URLs. ... In the SQL query, the data from 'cname' will be a string, like "Foo Internet", the data from 'mainurl' will be a url like "www.foo.com" ... I've googled for somehow using a timeout with IO::Socket, but all the responses seem to be that timeout is deprecated and only applies to the handshake, not the listen/read. ... my %hosts; ...
    (comp.lang.perl.misc)
  • Re: Setting up SMTP?
    ... > Server Type: SMTP ... > Use secure connection: ... > wanted to have all outgoing mail relayed via the ISP though. ... Curious on the "my MSA does not Relay via my ISP" ...
    (Fedora)