🚀 go-pugleaf

TvX en portatil <Tovaritx@mi28.tovaritx.red> wrote:

: necesito saber si un ordenador est� accesible via red desde un script de
: perl ya que de �l me bajo el correo con dicho script y la comprobaci�n
: se alarga innecesariamente cuando no hay conexi�n...


---------------------------------------------------------------------------
#!/usr/local/bin/perl 

require 'sys/socket.ph';
require 'flush.pl';


$nntpport =			"119";
$connecttimeout =	"4";
$news_on =			 2;

# 0 -> dead host
# 1 -> host up, dead nntp
# 2 -> OK



#
# Options
#
use Getopt::Long;

$DEF_QUIET =		 0;

sub usage
{
	warn "$0: @_\n" if @_;
	die <<EOF;
	usage: $0 [options] nntpserver
	Options are:
	--quiet               (default NOT)
	--log_file=string     (default no log at all)
EOF
}

$uok = GetOptions( qw(
log_file=s
quiet
help));

usage("Usage error!") unless $uok;
usage() if $opt_help;
usage("Need one and only nntp server argument") unless @ARGV == 1;

$nntp_server = $ARGV[0];
$quiet = $opt_quiet || $DEF_QUIET;
$log_file = $opt_log_file || "";

#
# init:
#
# First try nntp
#

$SIG{'ALRM'} = 'do_alarm';
do_connect ( $nntpport );
if ( $news_on == 2 )
{
	select(C);
	$| = 1;
	select(STDOUT);

	# Now rec data from C
	# need to alarm here

	alarm(1200);

	$_ = <C>;
	if( ! /^200 /)
	{
		print STDERR "Server error: $_" unless $quiet;
		$news_on = 1;
	}
	print C "Quit\n";
	$_ = <C>; print STDERR $_ unless $quiet;

	closeup:
	alarm(0);
}
shutdown (C, 1);
close(C);

use Net::Ping;

## Try echo
#print STDERR "ping..\n";
#print "$nntp_server is alive and kicking\n" if pingecho($nntp_server, 5);

## Try icmp
## Requires root privs.

if ( $news_on != 2 ) 
{
	print STDERR "Trying icmp ping $nntp_server...\n" unless $quiet;

	$p = Net::Ping->new("icmp") or die "Can't create a Net::Ping $!\n";
	if ( $p->ping($nntp_server,3) )
	{
		print STDERR "$nntp_server is alive\n" unless $quiet;
	}
	else
	{
		print STDERR "$nntp_server is dead\n" unless $quiet;
		$news_on=0;
	}
}

do_quit();

#
# End of program
#

sub do_quit
{
	if ( $log_file eq "" )
	{
		if ($news_on == 0)
		{
			print STDERR " Server Down, News down\n" unless $quiet;
			exit(1);
		}
		if ($news_on == 1)
		{
			print STDERR " Server Up, News down\n" unless $quiet;
			exit(1);
		}
		if ($news_on == 2)
		{
			print STDERR " Server Up, News Up\n" unless $quiet;
			exit(0);
		}

	}
	else
	{
		$current_date = makedate(time());
		open(OUT ,"|/usr/local/bin/gzip -9 >> $log_file") || \
		die "Can't open output: $!";
		print OUT "$current_date $news_on\n";
		close(OUT);
		exit ( $news_on );
	}
}

sub makedate {
	my $secs = shift;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
	my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
	my $dname = (qw{Sun Mon Tue Wed Thu Fri Sat})[$wday];
	return "$dname $mday/$mon/$year $min:$hour";
}


#
# Handle timeouts
#

sub do_alarm
{
	alarm(0); # reset alarm clock
	$SIG{'ALRM'} = 'do_alarm';
	print STDERR "Timeout (host died?)\n" unless $quiet;
	shutdown (C, 1);
	close(C);
	$news_on = 1;
}

#
# connect to service
#

sub do_connect
{
	local($port) = @_;

	print STDERR "Trying $nntp_server:$port...\n" unless $quiet;
	# seed & pick a random port number
	for ($i=0; $i < $$; $i++) { rand(); }

	$clientport = int(rand(32768) + 1024);
	$sockaddr = 'S n a4 x8';
	$locport=pack($sockaddr, &AF_INET, $clientport, "\0\0\0\0");

	if (!socket(C, &PF_INET, &SOCK_STREAM, $proto))
	{
			die "ERROR - couldn't create client socket: $!\n";
	}
	if (!bind(C, $locport))
	{
			die("ERROR - cannot bind client socket: $!\n");
	}

	($name, $aliases, $proto) = getprotobyname('tcp');
	($name, $aliases, $type, $len, $thisaddr) = gethostbyname($nntp_server);
	($a,$b,$c,$d) = unpack('C4', $thisaddr);

	$ipaddr="$a.$b.$c.$d";

	$thatport = pack($sockaddr, &AF_INET, $port, $thisaddr);

	alarm(0);
	alarm($connecttimeout);
	if (!connect(C, $thatport))
	{
		print STDERR "ERROR - connection failed: $!\n" unless $quiet;
		$news_on = 1;
	}

	alarm(0);
}

---------------------------------------------------------------------------
-- 
PGP and other useless info at      \                 La ciencia-ficcion es
http://www.cps.unizar.es/~spd/      \                 ese futuro en el que
finger://daphne.cps.unizar.es/spd    \                 lo seguro es que ya
ftp://ivo.cps.unizar.es/pub/          \    (F. Alfaro)  no seremos jovenes