#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
use Time::HiRes;
use Time::Local;
#use IO::Socket::IP;
use Socket qw(:addrinfo SOCK_RAW);
use File::Spec::Functions;
use Cwd 'abs_path';
use LWP::Simple;

my $vers = 'v.0.0.0.1';

my ( %nodelist, $nodes, $needhelp, $logfile, %sysopname, %sortednodes, $ndlfile,
     $hostname, $portaddress, $i, $check_updates );

abs_path($0) =~ /^(.*?)[\\\/]([^\\\/]+)$/;
my ( $curpath, $programfile ) = ( $1, $2 );

sub usage()
{
	print <<USE;

   Finds IPv6 nodes in the nodelist. Internet connection required.

   Usage:
   ~~~~~~
   $programfile [options] <nodelist>

   nodelist            - filename of nodelist. '*' and '?' may be used.

   Options:
        -h,--help		- this text
        -l,--log		- log file name. Optional.
        -u,--update     - How to update the program. Optional.
                              =d - download. Check for a new version and
                                   download the update to a new file.
                              =f - Force download callip.pl end exit even
                                   if no new version is found.
                              =w - warn. Check for a new version and warn
                                   the sysop. Default.
                              =n - no. Do nothing.

   Example:
   $programfile ~/nodelist/nodelist.* -l ~/logs/ipv6nodes.log 2>~/logs/errors.log

USE
exit;
}

sub writelog($)
{
    my ( $str ) = @_;
    my ($sec,$min,$hour,$mday,$month,$year) = (localtime)[0...5];
#    my $timestamp = sprintf("%04d-%02d-%02d %02d:%02d:%02d ",
#                            $year+1900, $month+1, $mday, $hour, $min, $sec);
#    $str =~ s/\n/\n$timestamp/g;
    print( "$str\n" );
    if ( defined( $logfile ) ) {
        if ( open( my $FLOG, '>>', $logfile ) ) {
#            print( $FLOG "$timestamp$str\n" );
            print( $FLOG "$str\n" );
            close( $FLOG );
        } else {
            print( STDERR "Can't open logfile $logfile. ($!)\n" );
        }
    }
}

sub update()
{
    return unless $check_updates =~ /^[wdf]$/;

    my ( $ver_s, $upd, $of, $HANDLE );
	my $url = 'http://brorabbit.g0x.ru/files/perl/';
	
    my $curpath = abs_path($0);
#    $curpath = Cwd::realpath($0) unless defined $curpath;
#    $curpath = Cwd::realpath('./') unless defined $curpath;
# $programfile

    $ver_s = get( $url . 'findIPv6.v');
    if (defined ($ver_s) ) {
	if ( $check_updates eq 'f' ) {
		if ( $curpath =~ /^(.*?)\.pl$/ ) {
		    $of = "$1_$ver_s\.pl";
		} elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) {
		    $of = $1 . "findIPv6_${ver_s}\.pl";
		} else {
		    $of = "${curpath}_${ver_s}\.pl";
		}
		print "Latest version is $ver_s\!\n";
		writelog("Latest version is $ver_s\! Downloaded filename is \'$of\'.\n");
	} elsif ( $vers lt $ver_s ) {
	    if ( $check_updates eq 'w' ) {
		print " \*\*\* You should update to $ver_s\! \*\*\* \n";
		writelog(" \*\*\* You should update to $ver_s\! \*\*\* \n");
		return;
	    } elsif ( $check_updates eq 'd' ) {
		if ( $curpath =~ /^(.*?)\.pl$/ ) {
		    $of = "$1_$ver_s\.pl";
		} elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) {
		    $of = $1 . "findIPv6_${ver_s}\.pl";
		} else {
		    $of = "${curpath}_${ver_s}\.pl";
		}
		print "You should update to $ver_s\!\n";
		writelog(" \*\*\* You should update to $ver_s\! Update filename is \'$of\'.\n");
	    }

	} else {
	    print "You have actual version.\n";
	    return;
	}
	$upd = get( $url . 'findIPv6.pl' );
	unless( defined $upd ) {
	    print STDERR "Can't get update.\n";
	    writelog("Can't get update. ${url}findIPv6.pl\n");
	    return;
	}
	my $tmp_of = $of . time();
	if ( open ( $HANDLE, '>', $tmp_of ) ) {
	    binmode($HANDLE);
	    print( $HANDLE $upd );
	    close($HANDLE);
	    print "Can't create $of ($!)." unless move( $tmp_of, $of );
	    chmod 0755, $of if $^O eq 'linux';
	    print "$of saved.\n\n";
	} else {
	    print STDERR "Can't open $of ($!).\n";
	    writelog( "Can't open $tmp_of ($!)." );
	}
    } else {
		print STDERR "Can't connect to $url\n";
		writelog("Can't connect to $url\n");
    }
    exit if $check_updates eq 'f';
}

sub read_ndl_time($)
{
   my ( $filename ) = @_;
   my ( $FH, $ndlstr, $line, $nltime, %month );

   $month{January} = 0;
   $month{February} = 1;
   $month{March} = 2;
   $month{April} = 3;
   $month{May} = 4;
   $month{June} = 5;
   $month{July} = 6;
   $month{August} = 7;
   $month{September} = 8;
   $month{October} = 9;
   $month{November} = 10;
   $month{December} = 11;
   
   if ( open( $FH, '<', $filename ) ) {
	$line = readline( $FH ); 
	close( $FH );
	if ( $line =~ /\;A \S+ Nodelist for \S+, (\S+) (\d+), (\d+) -- Day number \d+ : \d+/i ) {
		$nltime = timelocal( 0, 0, 0, $2, $month{$1}, $3 - 1900 );
		return $nltime;
	} else {
		print STDERR "Probably not a nodelist file $filename.\n";
		return 0;
	}
   } else {
	print STDERR "Cant read $filename ($!).";
	return 0;
   }
}

sub findndl($)

{
    my ( $filemask ) = @_;
    my $start = Time::HiRes::time();
    
    writelog("Finding last nodelist file from $filemask.");
    $filemask =~ /(.*?)([^\\\/]+)$/;
    my ( $ndlpath, $ndlfn ) = ( $1, $2 );
    my ( $nldate, $lastdate, $lastnl );
    $ndlpath = './' if !defined( $ndlpath ) || $ndlpath eq '';
	unless( -e $ndlpath ){
		print STDERR "\'$ndlpath\' does not exist!\n";
		exit;
	}
    $ndlfn =~ s/\./\\\./g;
    $ndlfn =~ s/\*/\.\*/g;
    $ndlfn =~ s/\?/\./g;
    $lastdate = 0;
    if ( opendir( DH, $ndlpath ) ) {
	while( readdir(DH) ) {
	    if( $_ =~ /^${ndlfn}$/i) {
		$nldate = read_ndl_time( catfile( $ndlpath, $_ ) );
		if ( $nldate > $lastdate ) {
		    $lastdate = $nldate;
		    $lastnl = $_;
		}
	    }
        }
    } else {
	print STDERR "Can't open $ndlpath. ($!)\n";
	exit;
    }
    unless( defined( $lastnl ) ) {
	print STDERR "Nodelist not found.\n";
	writelog( 'Nodelist not found.' );
	exit;
    }
    writelog( 'Last nodelist found at ' . sprintf( "%.3f" , ( Time::HiRes::time() - $start ) ) . ' seconds.' );
    return catfile( $ndlpath, $lastnl );
}


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

    unless ( -e $nlist ) {
	print( "No nodelist found!\n");
	writelog('ERROR! No nodelist found!');
	exit;
    }
    unless (open (F, "<$nlist")) {
	print( "Cannot read nodelist $nlist: $!\n");
	writelog("ERROR! Cannot read nodelist $nlist: $!");
	exit;
    }
    print("Parsing nodelist file $nlist \n");
    $start = Time::HiRes::time;
    $zone = $net = $node = 0;
    $domzone = $domreg = $domnet = $ird = "";
    $domain = 'binkp.net';
#    $domain = $rootdomain;
    $nodes = 0;
    while (defined($line = <F>)) {
	if( $line =~ /Nodelist ([a-zA-Z]+ [a-zA-Z]+\, [a-zA-Z]+ \d+\, \d+ \-\- Day number \d+)/i) {
	    $nldate = $1;
	    next;
	}
	$line =~ s/\r?\n$//s;
	next unless $line =~ /^([a-z]*),(\d+),([^,]*),[^,]*,([^,]*),([^,]*),\d+(?:,(.*))?\s*$/i;
	($keyword, $node, $name,$sysopn ,$phone, $flags) = ($1, $2, $3, $4, $5, $6);
#        unless( $ignoredown ) {
	        next if $keyword eq 'Down';
	        next if $keyword eq 'Hold';
	        next if $keyword eq 'Pvt';
#        }
	$uflag = '';
	%flags = ();
	%addr = ();
	@addr = ();
	if ($keyword eq 'Zone') {
	    $zone = $node;
	}
	if ( defined($flags) ) {
#	    if ( $flags =~ /\bCM\b/ ) {
#			$timetocall_s = '0000';
#			$timetocall_e = '2400';
#	    } elsif ( $flags =~  /\bICM\b/ ) {
#			$timetocall_s = '0000';
#			$timetocall_e = '2400';
#	    } elsif ( $flags =~ /\bT([a-z])([a-z])\b/i ) {
#		    $timetocall_s = $letters{$1};
#		    $timetocall_e = $letters{$2};
#	    } else {
#			if ( $flags =~ /(\#\d\d)/ ) {
#		    	$timetocall_s = $ZMH_s{$1};
#		    	$timetocall_e = $ZMH_e{$1};
#			} else {
#		    	$timetocall_s = $ZMH_s{$zone};
#		    	$timetocall_e = $ZMH_e{$zone};
#			}
#	    }
	foreach (split(/,/, $flags)) {
	    if (/^U/) {
		$uflag = 'U';
		next if /^U$/;
	    } else {
		$_ = "$uflag$_";
	    }
	    if (/:/) {
		$flags{$`} .= ',' if defined($flags{$`});
		$flags{$`} .= $';
	    } else {
		$flags{$_} .= ',' if defined($flags{$_});
		$flags{$_} .= '';
	    }
	}
	} else {
#	    $timetocall_s = $ZMH_s{$zone};
#	    $timetocall_e = $ZMH_e{$zone};
	}
	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"});
	$sysopn =~ s/_/ /g;
	$sysopname{"$zone:$net/$node"} = $sysopn;
#	if ( !defined( $timetocall_s ) || !defined( $timetocall_e ) ) {
#	    writelog( "Time to call $zone:$net/$node not defined. Assuming CM.");
#	    $timetocall_s = '0000';
#	    $timetocall_e = '2400';
#	}
#	$calltime{"$zone:$net/$node"}{s} = $timetocall_s;
#	$calltime{"$zone:$net/$node"}{e} = $timetocall_e;
	
#	if ( defined( $hostsonly ) ) {
#	    next unless $node == 0;
#	}
#	    if ( defined($fzone) ){
#		next unless $zone == $fzone;
#	    }
#	    if ( defined($lreg) ){
#		next unless $region == $lreg;
#	    }
#	    if ( defined($lnetw) ){
#		next unless $net == $lnetw;
#	    }
	$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++;
	    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++;
	    next;
	}
	if ($phone =~ /000-([1-9]\d*)-(\d+)-(\d+)-(\d+)$/) {
	    $addr{"$1.$2.$3.$4"} = 1;
	    push(@addr, "$1.$2.$3.$4");
	}
	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);
	    }
	}
	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, $_);
		}
	    }
	    if ($ird) {
		$_ = "f$node.n$net.z$zone.$ird.";
		unless ($addr{$_}) {
		    $addr{$_} = 1;
		    push(@addr, $_);
		}
	    }
	}
	unless( @addr ) {
#	    if ( defined( $override ) ){
		$nodelist{"$zone:$net/$node"} = "f$node.n$net.z$zone.$domain";
		$nodes++;
#	    }
	    next;
	}
	%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);
    my $lstr = "Nodelist $nldate parsed, $nodes IP-nodes processed (" . sprintf( "%.3f" ,(Time::HiRes::time() - $start) ) . " sec)\n";
    print( $lstr );
    writelog( $lstr );
#    $handle->shlock();
#    push @lines, $lstr;
#    $handle->shunlock();
}


sub getIP($$)
{
    my ( $hostname, $nod ) = @_;
#    print "Resolving host name \'$hostname\'.\n";
#    writelog("Resolving host name...\n") if $debug;
    my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW});
 #   my $r = '';
	if ( $err ) {
		print STDERR "$nod $hostname Error: Cannot getaddrinfo - $err\n";
#		$r = "$fn\t$hostname\t-\tError: Cannot getaddrinfo - $err" if $sbrief;
		return;
	}
	
	while( my $ai = shift @res ) {
		my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
		if ( $err ) {
	    	print STDERR "$nod Cannot getnameinfo - $err\n";
#	    	$r .= "\t$fn\t$hostname\:$portaddress\tCannot getnameinfo - $err" if $sbrief;
	    	undef $err;
	    	next;
		}
		next if $ipaddr =~ /^\d+\.\d+\.\d+\.\d+$/;
		writelog( sprintf( "%3s\. %-25s %-35s %-40s", $i, $nod, $sysopname{$nod}, $ipaddr ) );
		$i++;
#	$r .= connec2binkd($ipaddr,$portaddress,$fn,$hostname);
    }
#    return $r;
}

sub nodesort
{   my ($az, $an, $af, $ap, $bz, $bn, $bf, $bp);
    if ($a =~ /(\d+):(\d+)\/(\d+)(?:\.(\d+))?/) {
        ($az, $an, $af, $ap) = ($1, $2, $3, $4);
        $ap = 0 unless defined $ap;
    } else { return -1; }
    if ($b =~ /(\d+):(\d+)\/(\d+)(?:\.(\d+))?/) {
        ($bz, $bn, $bf, $bp) = ($1, $2, $3, $4);
        $bp = 0 unless defined $bp;
    } else { return 1; }
    return ($az<=>$bz) || ($an<=>$bn) || ($af<=>$bf) || ($ap<=>$bp);
}


# ---- MAIN --------->

	GetOptions ( 
				"help"        => \$needhelp,
                "update=s"    => \$check_updates,
        	    "log=s"       => \$logfile
				) or die("Error in command line arguments\n");

	$ndlfile = shift( @ARGV );

	usage() unless $ndlfile;
	$check_updates = 'w' unless $check_updates;
	update();
	$ndlfile = catdir( $ndlfile, '*.*' ) if -d $ndlfile;

	readndl( findndl( $ndlfile ) );
	$i = 1;
	foreach my $node ( sort nodesort keys %nodelist) {
#print "$node\n";
		foreach my $d ( split( ';', $nodelist{$node} ) ) {
			undef $portaddress;
			if ( $d =~ /^(.+?)[\.\]]?\:+(\d+)\.?$/ ) {
				( $hostname, $portaddress ) = ($1, $2);
			} else {
				$d =~ /(.*?)\.?$/;
				$hostname = $1;
			}
			getIP( $hostname, $node );
		}
	}
	$i--;
	writelog( "--- \n$i nodes found.\n" );