Listing 1: alp source

#!/usr/bin/perl
#
# ** Title:          alp
# ** Description:    An application ping program. # ** Author:         Ron Jachim
# ** Last Modified:  1 October 1998
# ** Legal:          Copyright 1998 Karmanos Cancer Institute All Rights Reserved.
#
use Socket;
$TRUE = 1;           # Make booleans easier to use.
$FALSE = ! $TRUE;    # Hopefully this follows from the above line ;-)

# Grab and store the command line arguments.

if ($#ARGV == 2) {  # remember, ARGV[-1] will be alp
($thathost,$service,$description) = @ARGV;
} elsif ($#ARGV == 3) {  # remember, ARGV[-1] will be alp
($params,$thathost,$service,$description) = @ARGV;
} else {
print "usage: alp [-vli] destination  port description\n"; exit 1;
}

# Operate on the optional command parameters as appropriate.

$_ = $params;
if (/V|v/) { $verbose = $TRUE; }
if (/L|l/) { $log = $TRUE; }
if (/I|i/) { $interactive = $TRUE; }
if (/C|c/) { print "Copyright 1998 Karmanos Cancer Institute All Rights Reserved.\n"; }

# Set the protocol to tcp and get its number.

$protocol = 'tcp';
($protocol,$aliases,$protocolnumber) = getprotobynumber($protocol);

# Get the destination host and get its IP address or name as appropriate.

$_ = $thathost;
if (/\D/) {  # if thathost is non-numeric, it must be a host name
($thathostname,$aliases,$type,$len,$thathostaddr) = gethostbyname($thathost);
} else { # if thathost is numeric, it must be a host address
($thathostname,$aliases,$type,$len,$thathostaddr) =
gethostbynumber($thathost);
}

# Get the local computer name and IP address.

chop($hostname = `hostname`);
($thishostname,$aliases,$type,$len,$thishostaddr) = gethostbyname($hostname);

if ($verbose) {
print <STDERR>, "protocol       = $protocol\n";
print <STDERR>, "protocolnumber = $protocolnumber\n"; print <STDERR>, "service        = $service\n";
print <STDERR>, "thathostname   = $thathostname\n"; print <STDERR>, "thishostname   = $thishostname\n\n";
}

# Set up for socket programming.

$sockaddr = 'S n a4 x8';
$that = pack($sockaddr, PF_INET, $service, $thathostaddr);

# Create a socket.

if (socket(S, PF_INET, SOCK_STREAM, $protocolnumber)) {
if ($verbose) {print <STDERR>, "socket() call  ok\n"};
} else {
if ($verbose) {print <STDERR>, "socket() call failed\n"};
if ($verbose) {print <STDERR>, "from a UNIX perspective, the problem is:
$!\n"};
}

# Prepare a datestamp if in log mode

if ($log) {
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $mon++;
if ($mday < 10) {$mday = "0$mday"};
if ($mon < 10) {$mon = "0$mon"};
if ($year < 50) {  # arrbitrarily dodge Y2K for a while ;-)
$year = "20$year";
} else {
$year = "19$year";
}
$datestamp = "$year-$mon-$mday || $hour:$min:$sec";
}

# Establish a connection or time out after 5 seconds of trying.

$SIG{ALRM} = \&timed_out;
eval {
alarm(5);
$erc = connect(S, $that);
alarm(0);
};
if ($erc) {
if ($verbose) {print <STDERR>, "connect() call  ok\n"};
if ($interactive) {print "Successful connection with $thathost, $protocol
socket
$service.\n"};
if ($log) {print "$datestamp || $description || UP\n"};
} else {
if ($verbose) {print <STDERR>, "connect() call failed\n"};
if ($verbose) {print <STDERR>, "from a UNIX perspective, the problem is:
$!\n"};
if ($interactive) {print "Attempt to connect to $thathost, $protocol socket
$service failed.\n"};
if ($log) {print "$datestamp || $description || DOWN\n"};
}

# Close the socket.

if (close(S)) {
if ($verbose) {print <STDERR>, "close ok\n"};
} else {
if ($verbose) {print <STDERR>, "close not ok\n"};
if ($verbose) {print <STDERR>, "from a UNIX perspective, the problem is:
$!\n"};
}

exit 1;

# This is the timeout function called earlier.

sub timed_out {
if ($verbose) {print <STDERR>, "connect() call timed out\n"}; die "TIMEDOUT";
}
