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
[download]

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';  
}
[download]

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.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.