At first glance, nothing significant is standing out to me. I mean, I'd not pass in the \%threads reference to forkportcheck, but handle that in the caller, and I'm not seeing why you have the inner while, unless it's to force the output in the same order as the input (which seems odd), but those are relatively minor.

The only thing I can think of that would improve this is to use event-based sockets. Which would be much easier if you were using AnyEvent, Coro, POE, or one of a myriad of other event systems available for Perl. This would eliminate the fork, allowing it all to be done in a single process. If you're connecting to systems on the internet, I doubt this will be much of a gain, and even if it's all on your intranet, it may be too little of a gain to be noticeable (though only one way to be sure!).

Of course, this would require some CPAN modules. Which, for some odd reason, you said you can't do. Since as I already responded to that, I'm not going to go into great detail here again. Just seems odd. I never see anyone say "I'm doing this in C# and I can't use nuget" or "I'm doing this in Javascript, and I can't use npm/bower/etc." Why is it just Perl that gets this treatment?

You are correct in assuming the while statement is to force output order. This part of the function was taken from the function that actually runs commands on the remote servers. When multiple lines of output are returned simultaneously we want the output to be grouped together instead of intertwined.

I've never used event-based sockets for anything as I'm still relatively new to the programming in general. Any suggestions on where to get started would be appreciated.

I should clarify the CPAN modules statement. Generally I can use anything from CPAN that is already prepackaged in an rpm for CENTOS7/RHEL7 and is in their default repositories. I can also grab modules that can be easily packaged using cpanspec. This tool is to be used internally by teams I support and other teams. Corporate policy forbids quite a few of these teams from having CPAN access so I'm limiting what I can use based on that. If it is a module with very little dependencies I'll consider it. Thanks for your input so far!

Generally speaking, I would print out the return values as I received them, but then, at the end, print out a nice pretty, ordered list. This allows for systems that respond quickly to show up quickly, and systems with lag responding to not delay the quick ones, at least during the running.

Where to get started - that is a matter of preference. I had someone here recommend AnyEvent and Coro to me ages ago, and that's what I'm using for the CB stats and last hour of cb updates (it's all in a single process and a single thread, making http calls to Perlmonks, both for downloading and uploading, and updating databases, and actually having a built-in chatterbox client as well). There's a pretty good chance that Coro won't be available in an RPM on RHEL/CentOS. However, Yes, even you can use CPAN might still be worth a read for your situation.

This seems like a similar problem to Optimized remote ping in particular Re: Optimized remote ping which was something I did before joining perlmonks. It essentially does what an async framework would do (all in one process).

Here's a slightly updated version:

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1135109
# http://perlmonks.org/?node_id=11103970

use strict;
use warnings;
use IO::Socket;
use IO::Select;

my @ips = map "192.168.1.$_", 1..20; # your IPs here
my $port = 22; # your port here
my $max = 500; # somewhat smaller than max "open files"

my %handles;
my $sel = IO::Select->new;

while( @ips or $sel->count )
  {
  if( @ips and $sel->count < $max )
    {
    my $ip = shift @ips;
    my $fh = IO::Socket::INET->new(PeerHost => $ip, PeerPort => $port,
      Proto => 'tcp', Blocking => 0);
    $handles{$fh} = "$ip:$port"; 
    $sel->add($fh);
    }
  elsif( @ips ? $sel->count >= $max : $sel->count )
    {
    for my $fh ( $sel->can_write )
      {
      print $fh->connected ? '   ' : 'not', " alive  $handles{$fh}\n";
      $sel->remove($fh);
      delete $handles{$fh};
      }
    }
  }
[download]

Thanks for the input tybalt89! I tested the version I had against the version you wrote on 7052 servers using time. The version I had performed better even after I added the timeout back into your version.

My Version:

real    1m6.522s
user    0m59.375s
sys     1m5.178s
[download]

Your Version:

^C

real    3m10.862s
user    0m0.685s
sys     0m0.507s
[download]

I'm not familiar enough with it. And note some of the servers in my list may no longer exist so it may have been hung up on some?

Testing on my system, I'm not sure the Timeout is working properly for connects.

Try this version with explicit timeouts for attempts over $timeout seconds.

Also, notice the extreme difference in 'user' and 'sys' times :)

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1135109
# http://perlmonks.org/?node_id=11103970

use strict;
use warnings;
use IO::Socket;
use IO::Select;
use Time::HiRes qw( time );

my @ips = map "192.168.1.$_", 1..20; # your IPs here
my $port = 22; # your port here
my $max = 1000; # somewhat smaller than max "open files"
my $timeout = 1;

my %handles;
my $sel = IO::Select->new;

while( @ips or $sel->count )
  {
  if( @ips and $sel->count < $max )
    {
    my $ip = shift @ips;
    my $fh = IO::Socket::INET->new(PeerHost => $ip, PeerPort => $port,
      Proto => 'tcp', Blocking => 0);
    $handles{$fh} = ["$ip:$port", $fh, time]; 
    $sel->add($fh);
    }
  elsif( @ips ? $sel->count >= $max : $sel->count )
    {
    my @connects;
    for my $fh ( @connects = $sel->can_write($timeout) )
      {
      print $fh->connected ? '   ' : 'not', " alive  $handles{$fh}[0]\
+n";
      $sel->remove($fh);
      delete $handles{$fh};
      }
    if( not @connects )
      {
      my $time = time - $timeout;
      for my $key ( keys %handles )
        {
        if( $handles{$key}[2] < $time )
          {
          print "not alive  $handles{$key}[0]\n";
          $sel->remove( $handles{$key}[1] );
          delete $handles{$key};
          }
        }
      }
    }
  }
[download]

There are several different ways to do the timeouts, I'm curious how this one works out. Others may be slightly faster on wall clock, but use much more CPU.

Here is my go, I like this blog entry about arguments in functions: https://www.matheus.ro/2018/01/29/clean-code-avoid-many-arguments-functions/

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use IO::Socket::INET;

sub portCheck {
        my ($server,$port) = @_;
        my $sock = IO::Socket::INET->new(
                PeerAddr => $server,
                Timeout => 1,
                PeerPort => $port,
                Proto => 'tcp',
        ) || return 0;
        return 1;
}

my @checks = (
        [ 'perlmonks.com',80 ],
        [ 'perlmonks.org',80 ],
        [ 'perlmonks.org',25],
);

my @kids;

for (@checks) {
        my $pid = fork // die;
        if ($pid) {
                push @kids,$pid;
                next;
        }
        exit portCheck(@$_);
}

for (0..$#kids) {
        print "@{$checks[$_]}\n";
        waitpid($kids[$_],0);
        print $? >> 8 ,"\n";
}
[download]

Thanks for the reply. I'll test that against what I have and check out that article soon. Also note there are quite a few arguments as I moved that function into a module so it needs to be passed arguments that use to be global vars inherited on the command line.

I tested your version against mine and it is around 8 seconds faster than my current version. Though tweaking your version to give similar output may negate some of that. This is the time output running against 7052 servers:

real    0m58.968s
user    0m50.566s
sys     1m3.864s
[download]

use v6;

port_check( ['perlmonks.com', 'fail.com', 'perlmonks.org'], 22 );

sub port_check( @nodes, $port ) 
{
    my @promises = @nodes.map( -> $host { 
        IO::Socket::Async.connect( $host, $port )
    });
    
    await Promise.allof( @promises );

    for @nodes Z @promises -> [$node, $promise]
    {
        if $promise.status ~~ Kept
        {
            given $promise.result
            {
                my $peer   = "{.peer-host}:{.peer-port}";
                my $socket = "{.socket-host}:{.socket-port}";
                say "$socket connected to $peer";
                .close;
            }
        }
        else
        {
            say "not connected to $node:$port";
        }
    }
}
[download]

D:\ENV>perl6 pcheck.pl
192.168.178.20:49859 connected to 216.92.34.251:22
not connected to fail.com:22
192.168.178.20:49861 connected to 209.197.123.153:22
[download]

use v6;

port_check( ['perlmonks.com', 'fail.com', 'fail.com', 'fail.com', 'fai
+l.com', 'fail.com', 'fail.com', 'fail.com', 'perlmonks.org'], 55, 2 )
+;

sub port_check( @nodes, $port = 22, $timeout = 10) 
{
    my @promises = @nodes.map( -> $host { 
        IO::Socket::Async.connect( $host, $port );
    });
    
    my @waits = @promises.map( -> $promise {
        Promise.anyof( Promise.in( $timeout ), $promise )
    });
    
    await Promise.allof( @waits );

    for @nodes Z @promises -> [$node, $promise]
    {
        if $promise.status ~~ Kept
        {
            given $promise.result
            {
                my $peer   = "{.peer-host}:{.peer-port}";
                my $socket = "{.socket-host}:{.socket-port}";
                say "$socket connected to $peer";
                .close;
            }
        }
        else
        {
            say "not connected to $node:$port";
        }
    }
}
[download]

Using v6 around here would be nice but unfortunately that currently isn't possible. I'll definitely keep this in mind for the future though if that ever becomes possible. :)