The following works for me, without timeouts, on both Linux and Windows XP SP2 and ActiveState perl 5.10.0:

use strict;
use warnings;
use Socket;

my $host = 'localhost';
my $port = shift || '8888';
my $timeout = 30;

my $result = portAlive();
print "result = $result\n";

sub portAlive {
    my $proto = getprotobyname('tcp');
    my $iaddr = inet_aton($host);
    my $paddr = sockaddr_in($port, $iaddr);
    
    socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || warn "socket: $!";
    
    eval {
      local $SIG{ALRM} = sub { die "timeout" };
      alarm($timeout);
      connect(SOCKET, $paddr) || error();
      alarm(0);
    };
    
    if ($@) {
      close SOCKET || warn "close: $!";
      # print "$hostname is NOT listening on tcp port $portnumber.\n";
      return 0;
    }
    else {
      close SOCKET || warn "close: $!";
      # print "$hostname is listening on tcp port $portnumber.\n";
      return 1;
    }
}
[download]

The code you posted is incomplete. Is it possible that your problem is elsewhere in your code?

Interesting. The failure is triggered outside of portAlive. The code below added calling portAlive() gives the error on Win2003 perl 5.10. Note that the service is an ordinary windows service, not actually doing anything on that port.

use strict;
use warnings;
use Socket;

my $host = 'localhost';
my $port = shift || '8888';
my $timeout = 3;

my $result = portAlive( 'localhost', 8888);
print "result = $result\n";
print `net start "CONTENTdm Monitor 9998"`;
exit;
[download]

-------------------------------------
Nothing is too wonderful to be true
-- Michael Faraday

eval {
  local $SIG{ALRM} = sub { die "timeout" };
  alarm($timeout);
  connect(SOCKET, $paddr) || error();
  alarm(0);
};
[download]

What is happening is (most likely) this:  when there's nothing listening on the port in question, the connect() fails more or less immediately ("connection refused") and the (non-existent) routine error() is being called. This dies with "Undefined subroutine &main::error called at...", so the alarm(0) isn't getting executed.  As the latter is supposed to reset the timer set up with the initial alarm($timeout), the timer keeps running and then fires later, outside of the eval{} scope, where the localized $SIG{ALRM} handler is no longer in effect...

In other words, the uncaught ALRM exception (on Windows emulated via SetTimer()/Windows Messages) is being reported as "Terminating on signal SIGALRM(14)".

Simplified demo:

#!perl

eval {
    local $SIG{ALRM} = sub { die "timeout" };
    alarm(1);
    error();  # not found -> dies
    alarm(0);
};
print "\$@: $@\n" if $@;

# do something that takes longer than a sec,
# without itself being implemented via SetTimer()
rand for 1..2e7;

__END__
H:\PM>perl 759131.pl
$@: Undefined subroutine &main::error called at 759131.pl line 6.

Terminating on signal SIGALRM(14)
[download]

Solution:  either move the alarm(0) outside of the eval{} (so it's always being executed), or set $SIG{ALRM} ='IGNORE' outside of the eval{} to ignore the timer 'signal'.

Great explanation. I moved alarm(0) outside of eval and that seems to do the trick.

thanks.

-------------------------------------
Nothing is too wonderful to be true
-- Michael Faraday

How can I detect if a port is in use?

I don't follow. You don't bind to a port, so the system will always assign you one that's not in use.

That means you're probably talking about the port to which you are connecting. What does it being "in use" mean to you? And why is that (rather than whether you can connect to it or not) is relevant?

Sorry, I don't seem to have the lingo down on this. An example will make things more clear.

Say I'd like to run Apache configured to answer on port 8888. OK, let's go check to see if any other program is "using" 8888. Might be a gopher server, telnet server, etc. I would like to detect if there is a server answering requests on 8888 already.

-------------------------------------
Nothing is too wonderful to be true
-- Michael Faraday

Just bind to the port. Trying to connect to the socket is slower and less reliable.

use strict;
use warnings;

use Errno  qw( EADDRINUSE );
use Socket qw( PF_INET SOCK_STREAM INADDR_ANY sockaddr_in );

sub port_available {
    my $family = PF_INET;
    my $type   = SOCK_STREAM;
    my $proto  = getprotobyname('tcp')  or die "getprotobyname: $!";
    my $host   = INADDR_ANY;  # Use inet_aton for a specific interface
    my $port   = '8888';

    socket(my $sock, $family, $type, $proto) or die "socket: $!";
    my $name = sockaddr_in($port, $host)     or die "sockaddr_in: $!";

    bind($sock, $name) and return 1;
    $! == EADDRINUSE   and return 0;
    die "bind: $!";
}

print port_available() ? "available\n" : "in use\n";
[download]

Tested on linux and Windows.

I would still like to know how this is useful to you.