If what you are trying to test is a server application that can handle more than one simultaneous connection then simply trying to connect a socket, seeing if it works and then disconnecting is all you need to do (you need 2 connections to handle the case when the target is up) We use this when we just want a very basic test.
use IO::Socket::INET;
print test_port_simple( 'perlmonks.org', 80, 1234, 'speak!' ), $/;
print test_port_simple( 'perlmonks.org', 81, 1234, 'speak!' );
sub test_port_simple {
my ( $server, $port, $timeout, $verbose ) = @_;
return "ERR - No server supplied" unless $server;
return "ERR - No port supplied" unless $port;
$timeout ||= 10;
print "Simple testing $server:$port\n" if $verbose;
my $sock = IO::Socket::INET->new( PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => $timeout,
ReuseAddr=> 1,
ReusePort=> 1,
);
my $res = $sock ? 'OK' : "ERR - Could not connect socket on port $
+port";
$sock->close() if $sock;
return $res;
}
__DATA__
Simple testing perlmonks.org:80
OK
Simple testing perlmonks.org:81
ERR - Could not connect socket on port 81
This proves the connectivity, not the functionality. We have had disk I/O issues in the past that left server processes in memory (and handling connections) but dyfunctional in any real sense. If your test target has an established protocol you can make the test far more reliable by printing a line to the socket and checking for the expected response.
sub test_port_detailed {
my ( $server, $port, $timeout, $verbose ) = @_;
# testing on port 25 requires sending (your) valid maildomain
my $MAILDOMAIN = 'hotmail.com';
return "ERR - No server supplied" unless $server;
return "ERR - No port supplied" unless $port;
$timeout ||= 10;
print "Detail testing $server:$port\n" if $verbose;
my $sock = IO::Socket::INET->new( PeerAddr => $server,
PeerPort => $port,
Proto => 'tcp',
Timeout => $timeout,
ReuseAddr=> 1,
ReusePort=> 1,
);
unless ( $sock ) {
undef $sock;
return "ERR - Could not connect socket on port $port";
}
my $errors = '';
# OK so we have a socket but can we use it as expected
# depending on the protocol we apply different tests....
if ( $port == 21 ) {
my $server = <$sock>;
if ( $server ) {
print $sock "USER anonymous\015\012";
$server = <$sock>;
$errors .= "No USER response from FTP server\n" unless $se
+rver;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from FTP server\n";
}
}
elsif ( $port == 25 ) {
my $server = <$sock>;
if ( $server ) {
print $sock "HELO $MAILDOMAIN\015\012";
$server = <$sock>;
$errors .= "No HELO response from SMTP server\n" unless $s
+erver and $server =~ m/^250/;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from SMTP server\n"
}
}
elsif ( $port == 80 ) {
print $sock "GET / HTTP/1.0\015\012\015\012";
my $server = <$sock>;
$errors .= "Unexpected response from HTTP server\n" unless $se
+rver and $server =~ m/^HTTP/;
}
elsif ( $port == 110 ) {
my $server = <$sock>;
if ( $server ) {
$errors .= "No OK sent by POP3 server\n" unless $server =~
+ m/OK/i;
print $sock "USER nobody\015\012";
$server = <$sock>;
print $sock "PASS wrong_password\015\012";
$server = <$sock>;
$errors .= "Failed to get expected ERR response\n" unless
+$server and $server =~ m/ERR/i;
print $sock "QUIT\015\012";
}
else {
$errors .= "No handshake sent from POP3 server\n";
}
}
elsif ( $port == 3128 ) {
print $sock "GET http://$server/ HTTP/1.0\015\012\015\012";
my $server = <$sock>;
$errors .= "Unexpected response from SQUID PROXY server\n" unl
+ess $server and $server =~ m/^HTTP/i;
}
else {
# we don't have a detail test but do have a socket so this is
+a NOP
}
$sock->close();
return $errors ? "ERR - $errors" : 'OK';
}
Note you probably won't be able to use the ReusePort flag on win 32 - SO_REUSEPORT will probably be undefined, so just comment that line out.
| 