package TCPReqWorker;

@TCPReqWorker::ISA = qw( CWorker );

use FileHandle;
use Socket;
use MicroTime;

my %known_ports = (
    "pop3", 110,
    "smtp", 25,
    "ica", 1494,
    "nntp", 119,
    "smb", 139,
    "dns", 53,
    "ssh", 22,
    "telnet", 23,
    "time", 37,
    "bootps", 67,
    "gopher", 70,
    "http", 80,
    "kerberos", 88,
    "sunrpc", 111,
    "auth", 113,
    "ntp", 123,
    "netbios-ns", 137,
    "netbios-dgm", 138,
    "netbios-ssn", 139,
    "ftp", 21,
	"imap", 143
);


my %protocols = (
    "nntp" 	=> [ "", "^20" ],
    "ica"	=> [ "", "ICA" ],
    "pop3"	=> [ "", "\\+OK" ],
    "telnet"	=> [ "", "." ],
    "ssh"	=> [ "", "SSH" ],
    "smtp"	=> [ "", "^22" ],
    "ftp"	=> [ "", "^2" ],
    "imap"	=> [ "", "\\* OK" ],
    "http"	=> [ "HEAD \$spec1 HTTP/1.0\r\n\r\n", "HTTP.[\\.0-9]+ [123]" ]
);

my $tcp_proto = (getprotobyname('tcp'))[2];
die "cannot determine TCP protocol number" unless( $tcp_proto );

sub new
{
    my ($this, $info, $var, $env ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    bless($self, $class);
    $self->{"TCP.info"} = $info;
    $self->{"TCP.env"} = $env;
    $self->{"TCP.var"} = $var;
    $self->{"TCP.started"} = 0;
    $self->initialize();
    $self->criticalness( 3 );
    return $self;
}


sub startup {
    my( $self ) = @_;

    print "TCP monitor initializing\n" if( $BigSister::common::dl>2 );
    $self->{"TCP.started"} = 1;
    my $env = $self->{"TCP.env"};
    my $port;
    my $service;
    my $id;
    if( $self->{"TCP.var"} =~ /^([^.]*)\.([^.]*)\.(status|message|time)\.(\d+)/ ) {
	$port = $1;
	$service = $2;
	$id = $4;
    }
    else {
	print "  TCP monitor cannot handle: ".($self->{"TCP.var"})."\n" if( $BigSister::common::dl>4 );
        Requester::Requester::set_cache( $self->{"TCP.env"}, "tcp", $self->{"TCP.var"}, "N/A" );
	$self->finish();
        return undef;
    }
    my $timeout = $env->expand_value( "timeout" );
    ($timeout = 8) unless( $timeout );
    my $warntimeout = $env->expand_value( "warntimeout" );
    ($warntimeout = $timeout/2) unless( $warntimeout );
    my $chat = $env->expand_values( "chat" );
    ($chat = $protocols{$service}) unless( $chat && @$chat );
    if( $chat ) {
	# we must copy here since later we are using shift
	my @chat = @$chat;
	$chat = \@chat;
    }
    $self->{"TCP.timeout"} = $timeout;
    $self->{"TCP.warntimeout"} = $warntimeout;
    $self->{"TCP.chat"} = $chat;
    $self->{"TCP.port"} = $port;
    $self->{"TCP.service"} = $service;
    $self->{"TCP.id"} = $id;
    $self->{"TCP.write"} = 1;
    $self->{"TCP.buff"} = "";
    $self->{"TCP.connected"} = 0;
    $self->{"TCP.spec1"} = $env->expand_value( "spec1" );
    $self->{"TCP.log"} = "";
    print "  TCP port $port, service $service, timeout $timeout\n" if( $BigSister::common::dl>4 );
    unless( defined $self->{"info"}->{$self->{"TCP.id"}} ) {
        $self->{"info"}->{$self->{"TCP.id"}} = {};
    }
    my $nport = (getservbyname($port, 'tcp'))[2];
    $nport = $known_ports{$port} unless( $nport );
    if( ($port =~ /^\d+$/) && ! defined $nport ) {
        $nport = $port;
    }
    my $ip = inet_aton( $self->{"TCP.env"}->{"nodeinstance"}->{"host"} );
    my $fh = $self->{"TCP.fh"} = new FileHandle();
    unless( $ip && $nport 
            && socket( $fh, &PF_INET(), &SOCK_STREAM(), $tcp_proto ) ) {
	print "  TCP configuration mistake\n" if( $BigSister::common::dl>4 );
	$self->status( 2, "CONFIGURATION MISTAKE" );
	$self->finish();
	return;
    }

    my $saddr = sockaddr_in( $nport, $ip );
    my $isnonblock = Platform::socknonblock( $fh );
    $self->{"TCP.start"} = time;
    $self->{"TCP.diffstart"} = MicroTime::gettimeofday();
    my $ok = 0;
    eval {
	# if socket is not in non-blocking mode we will (try) to
	# timeout using alarm()
	# otherwise connect() will return immediately
        $SIG{'ALRM'} = sub { die; };
	print "  TCP connecting ...\n" if( $BigSister::common::dl>5 );
	Platform::bsalarm( $self->{"TCP.timeout"} );
	unless( connect( $fh, $saddr ) ) {
	    die unless( $isnonblock );
	}
	$ok = 1;
	Platform::bsalarm( 0 );
    };
    $SIG{'ALRM'} = "IGNORE";
    if( ! $ok ) {
        $self->status( 0, "NO CONNECT" );
	$self->finish();
	print "  TCP connection failed: $!\n" if( $BigSister::common::dl>4 );
	return;
    }
    $self->{"filenumber"} = $fh->fileno();
    $self->{"read"} = 0;
    $self->{"write"} = 1;
    $self->{"timeout"} = $self->{"TCP.start"} + $self->{"TCP.timeout"};
    print "  TCP file number is ".($fh->fileno())."\n" if( $BigSister::common::dl>5 );
}



sub status {
    my( $self, $status, $message ) = @_;

    print "  TCP setting status to $status ($message)\n" if( $BigSister::common::dl>4 );
    my $name = ($self->{"TCP.port"}).".".($self->{"TCP.service"});
    $self->{"TCP.info"}->{$self->{"TCP.id"}}->{"$name.status"} = $status;
    $self->{"TCP.info"}->{$self->{"TCP.id"}}->{"$name.message"} = $message;
    $self->{"TCP.info"}->{$self->{"TCP.id"}}->{"$name.time"} = ($status == 0)?-1:(int( MicroTime::difftime( $self->{"TCP.diffstart"}, MicroTime::gettimeofday() ) *100 + 0.5 )/100) ;
    my $log = $self->{"TCP.log"};
    $log =~ s/\r\n/\n/g;
    $log =~ s/[\x00-\x09\x0b-\x1f\x7f-\xff]/./g;
    $log = substr( $log, 0, 400 );
    $self->{"TCP.info"}->{$self->{"TCP.id"}}->{"$name.log"} = $log;
}


sub sockclose {
    my( $self ) = @_;

    $self->finish();
    close( $self->{"TCP.fh"} );
}



sub do {
    my( $self ) = @_;
    unless( $self->{"TCP.started"} ) {
	$self->startup();
	return;
    }

    my $mask = '';
    vec( $mask, $self->{"TCP.fh"}->fileno(), 1 ) = 1;

    print "  TCP polling\n" if( $BigSister::common::dl>6 );
    my $chat = $self->{"TCP.chat"};
    my $timedout = $self->{"timeout"} <= time;
    my $wmask = $mask;
    my $nullmask = 0;
    my $write_ready = select( undef, $wmask, undef, 0 ) >0 ; 
    my $nullmask = 0;
    my $rmask = $mask;
    my $read_ready = select( $rmask, undef, undef, 0 ) >0 ; 
    my $nullmask = 0;
    my $exception = select( undef, undef, $mask, 0 ) >0 ; 
    if( $self->{"TCP.write"} ) {
	if( ! $write_ready ) {
	    $self->status( 0, $timedout ? "TIMED OUT" : "CONNECT FAILED" );
	    $self->sockclose();
	    return;
	}
	my $write = ($chat && shift @$chat);
	my $spec1 = $self->{"TCP.spec1"};
	$write =~ s/\$spec1/$spec1/g;
	if( $write ) {
	    my $log = ">> ".$write;
	    $log =~ s/\n$//ms;
	    $log =~ s/\n/\n>> /gms;
	    $log .= "\n";
	    $self->{"TCP.log"} .= $log;
	    unless( send( $self->{"TCP.fh"}, $write, 0 ) ) {
	        $self->status( 0, ($self->{"TCP.connected"})?"SEND FAILED":"CONNECT FAILED" );
		$self->sockclose();
		return;
	    }
	    $self->{"TCP.connected"} = 1;
	}
	$self->{"TCP.write"} = $self->{"write"} = 0;
	$self->{"read"} = 1;
    }
    if( $read_ready ) {
        my $buff;
	my $pattern = ($chat&&@$chat)?($chat->[0]):".*";
	unless( (defined recv( $self->{"TCP.fh"}, $buff, 1024, 0 )) && $buff ) {
	    print "  TCP error: $!\n" if( $BigSister::common::dl > 4 );
	    $self->status( 0, ($self->{"TCP.connected"})?"CHAT FAILED":"CONNECT FAILED" );
	    $self->sockclose();
	    return;
	}
	if( $buff ) {
	    my $log = "<< ".$buff;
	    $log =~ s/\n$//ms;
	    $log =~ s/\n/\n<< /gms;
	    $log .= "\n";
	    $self->{"TCP.log"} .= $log;
	}
	$self->{"TCP.connected"} = 1;
	$self->{"TCP.buff"} .= $buff;
	if( $self->{"TCP.buff"} =~ /$pattern/ ) {
	    $self->{"TCP.write"} = $self->{"write"} = 1;
	    $self->{"read"} = 0;
	    shift @$chat if( $chat && @$chat );
	    $self->{"TCP.buff"} = "";
	}
	elsif( length( $self->{"TCP.buff"} ) > 5000 ) {
	    $self->status( 1, "excessive data" );
	    $self->sockclose();
	    return;
	}
    }
    unless( $chat && @$chat ) {
	if( $self->{"TCP.warntimeout"} + $self->{"TCP.start"} <= time ) {
	    $self->status( 1, "OK but lame" );
	}
	else {
	    $self->status( 3, "OK" );
	}
	$self->sockclose();
	return;
    }
}


sub timed_out {
    my( $self ) = @_;

    $self->status( 0, "TIMED OUT" );
    $self->sockclose();
}



package Requester::tcp;

use strict;
use CWorker;
use Requester::Requester;


@Requester::tcp::ISA = qw(Requester::Requester);

my $requester = new Requester::tcp();

sub new
{
    my ($this, $args ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    bless($self, $class);
    $self->register( "tcp" );
    return $self;
}




# the default "request()" method is good enough for our purposes


sub getinfo {
    my( $self, $vars, $indexes ) = @_;

    # we cannot walk the tcp domain
    return undef unless( $indexes );
    my $info = {};
    my $worker = new CWorker();
    $worker->{"Test.info"} = $info;

    my %tests = ();

    foreach my $test (@$vars) {
        my $service = $test;
	next unless( $service =~ /([^.]*)\.([^.]*)\./ );
	$service = ($1.$2);
	next if( $tests{$service} );
	$tests{$service} = 1;
        my $tester = new TCPReqWorker( $info, $test, $self->{"env"} );
	$worker->start_after( $tester );
    }
    return $worker;
}


1;

