🚀 go-pugleaf

BT <BT < <buscando@cuenta.chula.es>>> wrote:

:     �C�mo se hace? A ver si me podeis dar alguna pista, si hay que incluir
: algo especial, o mandar alg�n peque�o programa de ejemplo que pueda

#!/usr/local/bin/perl

#require 'sys/socket.ph';
use Socket;
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];
    $mon = $mon + 1;
    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);
}

: retocar. �Ojo, que es una conexi�n _udp_ y no tcp!

	mala suerte, tendras que tocar el codigo


-- 
PGP and other useless info at      \                 Oh, show us the way
http://www.cps.unizar.es/~spd/      \             to the next whisky bar
finger://daphne.cps.unizar.es/spd    \                      Weill/Bretch
es doloroso ser sabio y descubrir la sopa de ajo                   (Pla)