#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
#use IO::Socket::INET;
use IO::Socket::IP;
use Socket qw(:addrinfo SOCK_RAW);

my ($lreg,$lnetw,$logfile, $fnode, $ndlfile);
GetOptions ("region=s"   => \$lreg,
            "net=s"      => \$lnetw,
            "fnode=s"    => \$fnode,
#            "list=s"     => \$ndlfile,
            "log=s"      => \$logfile)  # string
or die("Error in command line arguments\n");

$ndlfile = shift @ARGV;

#$hostname = 'brorabbit.g0x.ru';
#$hostname = '192.168.58.58';

my ( $hostname, $portaddress );

my $myaka = '2:460/5858.5858';

my (%nodelist,%sortednodes);

sub help
{
    print "Usage: $0 [options] nodelist_file_name\n".
	  "~~~~~\n".
	  "         -l,--log log_file_name - file name of log file\n".
	  "         -f,--fnode address     - address of node to call. Optional.\n".
	  "         -r,--region number     - number of region to test all nodes. Optional.\n";
    exit;
}

help() unless defined $ndlfile;

sub readndl($)
{
    my ($nlist) = @_;
    my ($zone, $net, $node, $region, $dom, $ird, $domain, $start);
    my ($line, $keyword, $name, $phone, $flags, $port, $lport, %port,
            %lport, $nodes, $i, $addr);
    my (%flags, $uflag, %addr, @addr, $domzone, $domreg, $domnet, $domflag);

    unless ($nlist) {
	print( "No nodelist found!\n");
	writelog('ERROR! No nodelist found!');
	return;
    }
    unless (open (F, "<$nlist")) {
	print( "Cannot read nodelist $nlist: $!\n");
	writelog('ERROR! Cannot read nodelist $nlist: $!');
	return;
    }
    print("Parsing nodelist file $nlist \n\n");
    $start = time();
    $zone = $net = $node = 0;
    $domzone = $domreg = $domnet = $ird = "";
    $domain = 'binkp.net';
    $nodes = 0;
    while (defined($line = <F>)) {
	$line =~ s/\r?\n$//s;
	next unless $line =~ /^([a-z]*),(\d+),([^,]*),[^,]*,[^,]*,([^,]*),\d+(?:,(.*))?\s*$/i;
	($keyword, $node, $name, $phone, $flags) = ($1, $2, $3, $4, $5);
	next if $keyword eq "Down";
	next if $keyword eq "Hold";
	next if $keyword eq "Pvt";
	next unless defined $flags;
	$uflag = "";
	%flags = ();
	%addr = ();
	@addr = ();
	foreach (split(/,/, $flags)) {
	    if (/^U/) {
		$uflag = "U";
		next if /^U$/;
	    } else {
		$_ = "$uflag$_";
	    }
	    if (/:/) {
		$flags{$`} .= "," if defined($flags{$`});
		$flags{$`} .= $';
	    } else {
		$flags{$_} .= "," if defined($flags{$_});
		$flags{$_} .= "";
	    }
	}
	if ($keyword eq "Zone") {
	    $zone = $region = $net = $node;
	    $node = 0;
	    $domzone = $domreg = $domnet = "";
	    foreach $i (qw(M 1 2 3 4)) {
		$domzone = $domreg = $domnet = "DO$i:" . $flags{"UDO$i"} if $flags{"UDO$i"};
	    }
	    $ird = $flags{"IRD"};
	} elsif ($keyword eq "Region") {
	    $region = $net = $node;
	    $node = 0;
	    $domreg = $domnet = "";
	    foreach $i (qw(M 1 2 3 4)) {
		$domreg = $domnet = "DO$i:" . $flags{"UDO$i"} if $flags{"UDO$i"};
	    }
	    $ird = $flags{"IRD"};
	} elsif ($keyword eq "Host") {
	    $net = $node;
	    $node = 0;
	    $domnet = "";
	    foreach $i (qw(M 1 2 3 4)) {
		$domnet = "DO$i:" . $flags{"UDO$i"} if $flags{"UDO$i"};
	    }
	    $ird = $flags{"IRD"};
	}
	next unless defined($flags{"IBN"});
	$sortednodes{"$zone\:$net\/$node"} = $region;
	%port = ();
	foreach (split(/,/, $flags{"IBN"})) {
	    if (/^\d*$/) {
		$port{/\d/ ? ":$_" : ""} = 1;
		next;
	    }
	    $lport = "";
	    ($_, $lport) = ($`, ":$'") if /:/;
	    $_ .= "." unless /^\d+\.\d+\.\d+\.\d+$|\.$/;
	    %lport = ($lport ? ( ":$lport" => 1 ) : %port);
	    $lport{""} = 1 unless %lport;
	    foreach $lport (keys %lport) {
		next if $addr{"$_$lport"};
		$addr{"$_$lport"} = 1;
		push(@addr, "$_$lport");
	    }
	}
	if (@addr) {
	    $nodelist{"$zone:$net/$node"} = join(';', @addr);
	    $nodes++;
#	    print( "Fetch addr for $zone:$net/$node: " . $nodelist{"$zone:$net/$node"} . " (IBN flag)\n");
	    next;
	}
	$port{""} = 1 unless %port;
	if ($_ = $flags{"INA"}) {
	    foreach (split(/,/, $flags{"INA"})) {
		$_ .= "." unless /^\d+\.\d+\.\d+\.\d+$|\.$/;
		foreach $port (keys %port) {
		    next if $addr{"$_$port"};
		    $addr{"$_$port"} = 1;
		    push(@addr, "$_$port");
		}
	    }
	    $nodelist{"$zone:$net/$node"} = join(';', @addr);
	    $nodes++;
#	    print("Fetch addr for $zone:$net/$node: " . $nodelist{"$zone:$net/$node"} . " (INA flag)\n");
	    next;
	}
	if ($phone =~ /000-([1-9]\d*)-(\d+)-(\d+)-(\d+)$/) {
	    $addr{"$1.$2.$3.$4"} = 1;
	    push(@addr, "$1.$2.$3.$4");
#	    print( "Fetch addr for $zone:$net/$node: $1.$2.$3.$4 (phone)\n");
	}
	if ($name =~ /^(\d+\.\d+\.\d+\.\d+|[a-z0-9][-a-z0-9.]*\.(net|org|com|biz|info|name|[a-z][a-z]))$/) {
	    $name .= "." if $name =~ /[a-z]/;
	    unless ($addr{$name}) {
		$addr{$name} = 1;
		push(@addr, $name);
#		print( "Fetch addr for $zone:$net/$node: $name (system name)\n");
	    }
	}
	unless (@addr) {
	    $domflag = ($domnet || $domreg || $domzone);
	    foreach $i (qw(M 1 2 3 4)) {
		$domflag = "DO$i:" . $flags{"UDO$i"} if $flags{"UDO$i"};
	    }
	    if ($domflag =~ /^DO(.):/) {
		($i, $dom) = ($1, $');
		if ($i eq 'M') {
		    $_ = "f$node.n$net.z$zone.$domain.$dom.";
		} elsif ($i eq '4') {
		    $_ = "f$node.n$net.z$zone.$dom.";
		} elsif ($i eq '3') {
		    $_ = "f$node.n$net.$dom.";
		} elsif ($i eq '2') {
		    $_ = "f$node.$dom.";
		} elsif ($i eq '1') {
		    $_ = "$dom.";
		}
		unless ($addr{$_}) {
		    $addr{$_} = 1;
		    push(@addr, $_);
#		    print( "Fetch addr for $zone:$net/$node: $_ (DO$i flag)\n");
		}
	    }
	    if ($ird) {
		$_ = "f$node.n$net.z$zone.$ird.";
		unless ($addr{$_}) {
		    $addr{$_} = 1;
		    push(@addr, $_);
		    Log(8, "Fetch addr for $zone:$net/$node: $_ (IRD flag)");
		}
	    }
	}
	next unless @addr;
	%addr = ();
	foreach $addr (@addr) {
	    foreach $port (keys %port) {
		$addr{"$addr$port"} = 1;
	    }
	}
	if(defined($port)){
	    $_ .= $port foreach @addr;
	}
	$nodelist{"$zone:$net/$node"} = join(';', keys %addr);
	$nodes++;
    }
    close(F);
    print( "Nodelist $nlist parsed, $nodes IP-nodes processed (" . (time() - $start) . " sec)\n");
    writelog("Nodelist $nlist parsed, $nodes IP-nodes processed (" . (time() - $start) . " sec)");
}

sub connec2binkd($)
{
  my ($host) = @_;
  my ($resp, $ok);

#  my $sock = IO::Socket::INET->new(PeerAddr => $host,
  my $sock = IO::Socket::IP->new(PeerAddr => $host,
	PeerPort => $portaddress,
	Proto    => 'tcp') ||  print "error $!\n" &&
				writelog("  $host - Error $!") &&
				return;

	my $str = "VER Call_Robot/0.1/Linux binkp/1.0";
	syswrite($sock, "\x80" . chr(length($str) + 1) . "\x00" . $str);
	syswrite($sock, "\x80" . chr(length($myaka) + 1) . "\x01" . $myaka);
	while (sysread($sock, my $r, 16384)>0) {
	        #debug("<< $r");
	        $resp .= $r;
	        if ($resp =~ m@binkp/1.[01]|TIME @i) {
	                $ok = 1;
			print " - Ok!\n";
			writelog("  $host - Ok!");
#			print "$resp\n\n";
	                last;
	        }
	}
close($sock);
}

sub writelog
{
    my ( $str ) = @_ ;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    
    if ( defined($logfile) )
    {
        if ( open( FLOG, ">>$logfile") )
        {
        print( FLOG ($year+1900)."-". sprintf("%02d",$mon+1)."-". 
	sprintf("%02d",$mday)." ". sprintf("%02d",$hour).":".
	sprintf("%02d",$min).":". sprintf("%02d",$sec) . " $str\n" );
        close( FLOG );
        }
        else
        {
            printf( STDERR "Can't open $logfile. ($!)\n" );
        }
    }
}

sub testcall
{
    my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW});
    if ( $err ) {
	print "Cannot getaddrinfo - $err\n";
	writelog( "Cannot getaddrinfo - $err" );
	return;
    }

    while( my $ai = shift @res ) {
	my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
	if ( $err ) {
	    print "Cannot getnameinfo - $err\n";
	    writelog("Cannot getnameinfo - $err");
	    undef $err;
	    next;
	}
	print "$ipaddr\n";
#	writelog($ipaddr);
	connec2binkd($ipaddr);
    }
}

sub callnode
{
    writelog("Calling $fnode");
    foreach my $d ( split( ';', $nodelist{$fnode} ) ) {
	undef $portaddress;
        if ( $d =~ /(.+?)\.?\:(\d+)$/ ) {
	    ( $hostname, $portaddress ) = ($1, $2);
	} else {
	    $d =~ /(.*?)\.?$/;
	    $hostname = $1;
	}
	$portaddress = '24554' unless defined $portaddress;
	print "$hostname, $portaddress\n";
	writelog(" $hostname\:$portaddress");
	testcall();
    }
}

readndl($ndlfile);

print "$fnode\n" if defined $fnode;
print "\'$nodelist{$fnode}\'\n" if defined $nodelist{$fnode};
unless ( defined $fnode ) {
	foreach my $nn (sort keys %nodelist) {
	    if (defined($lreg)) {
		next unless $sortednodes{"$nn"} eq $lreg;
	    }
	    $fnode = $nn;
	    print "$fnode\n";
	    callnode();
	}
    } else {
	callnode();
    }

#exit unless defined $nodelist{$fnode};

exit;
#testcall();