#!/usr/local/bin/perl -w-- # -*- perl -*-
#
# $Id: host_up,v 1.2 1995/11/08 21:57:40 ejb Exp $
# $Source: /home/ejb/scripts/RCS/host_up,v $
# $Author: ejb $
#

# This code, from the perl manual page, forces this to be run by perl from 
# perl, sh, or csh.  It must be first.
eval '(exit $?0)' && eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
& eval 'exec /usr/local/bin/perl -S $0 $argv:q'
    if 0;

$whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;

#
# Id: TCPConnection.pm,v 1.5 1995/10/14 13:09:42 qjb Exp
# Source: /home/qjb/source/perl/modules/RCS/TCPConnection.pm,v
# Author: qjb
#

require 5.000;
use strict qw(refs subs);

&usage if (@ARGV == 0);

package TCPConnection;
$package = "TCPConnection";

use Socket;

# Field names
$f_socket = "socket";

# Static Variables
$sockaddr = 'S n a4 x8';
chop($hostname = `hostname`);
($x, $x, $proto) = getprotobyname('tcp');
($x, $x, $x, $x, $thisaddr) = gethostbyname($hostname);
$namethis = pack($sockaddr, &AF_INET, 0, $thisaddr);
$thisaddr = pack('C4', 127, 0, 0, 1);
$localthis = pack($sockaddr, &AF_INET(), 0, $thisaddr);

# Routines

sub new
{
    shift;
    my $rep = +{$package => {} };
    local(*S);

    if (@_ != 2)
    {
	die "$package: Usage: new $package(port, host)\n";
    }
    local($remotehost, $portname) = @_;

    local($port, $thataddr, $that);

    eval
    {
	if ($portname =~ m/^\d+$/)
	{
	    $port = $portname;
	}
	else
	{
	    (($x, $x, $port) = getservbyname($portname, 'tcp')) ||
		die "unknown service $portname\n";
	}
	(($x, $x, $x, $x, $thataddr) = gethostbyname($remotehost)) ||
	    die "unknown host $remotehost\n";
	$that = pack($sockaddr, &AF_INET(), $port, $thataddr);
	eval
	{
	    socket(S, &PF_INET(), &SOCK_STREAM(), $proto) || die "socket: $!\n";
	    bind(S, $localthis) || die "bind: $!";
	    connect(S, $that) || die "connect: $!";
	};
	if ($@)
	{
	    close(S);
	    socket(S, &PF_INET(), &SOCK_STREAM(), $proto) || die "socket: $!\n";
	    bind(S, $namethis) || die "bind: $!";
	    connect(S, $that) || die "connect: $!";
	}
    };
    die "$package: connection to $remotehost on port $port: $@" if $@;
    $x = select(S);
    $| = 1;
    no strict 'refs';
    select($x);
    use strict 'refs';

    $rep->{$package}{$f_socket} = *S;

    bless $rep;
}

sub socket
{
    my $rep = shift;
    $rep->{$package}{$f_socket};
}
    

sub print
{
    my $rep = shift;
    local(*S) = $rep->socket();
    print S @_;
}

sub printf
{
    my $rep = shift;
    local(*S) = $rep->socket();
    printf S @_;
}

sub get
{
    my $rep = shift;
    local(*S) = $rep->socket();
    scalar(<S>);
}

sub DESTROY
{
    my $rep = shift;
    local(*S) = $rep->socket();
    close(S);
}

# End of TCPConnection

package main;

sub alarm { $SIG{'ALRM'} = \&alarm; }
&alarm;

for (@ARGV)
{
    print $_, "\n" if (&up($_));
}

sub up
{
    local($host) = shift;
    alarm 5;
    eval
    {
	new TCPConnection($host, "echo");
    };
    alarm 0;
    ($@ ? 0 : 1);
}

sub usage
{
    print STDERR "Usage: $whoami host [ host ... ]\n";
    print STDERR "  print name of each given host if it accepts a " .
	"connection on the echo port\n";
    exit 2;
}
