#!/usr/bin/perl

use strict;
use warnings;

use pkt;
use Getopt::Long;
use Time::HiRes;
use LWP::Simple;
use Cwd 'abs_path';
use File::Copy;
use File::Spec::Functions;
use Time::Local;

my $vers = '0.0.0.4';
my $url = 'http://brorabbit.g0x.ru/files/perl/';

my ( $msgtoname, $attr, $msgtxt, 
     $msgsubj, $msgarea ) = ( 'Ping', PVT+LOC, 'Routing test message.',
     'Ping', undef );

my ( $pktfrom, $pktto, $password ) = ( '2:460/5858', '2:460/58', '232018' );

my ( $lreg, $lnetw,$logfile, $fnode, $fzone, $ndlfile, $needhelp, $nldate,
	$check_updates, $configfile, $export, $flagdir, $aka, %nodelist,
	$prinver, $whatsnew, $cmdstr, $testconf, $oneping, %pingednet, $nozero );

my %config = (  'msgfromname' => 'SysOp Name',
		'msgfromaddr' => '9:9999/9999',
		'msgchrs'     => '',
		'pktfrom'     => '9:9999/9999',
		'pktto'       => '9:9999/9998',
		'password'    => '',
		'outdir'      => '',
		'logfile'     => '',
		'nodelist'    => '',
		'update'      => 'warn' );

sub usage()
{

	$0 =~ /([^\\\/]+$)/;
	print <<USAGE;
  fidoping.pl is designed to create Ping messages to several nodes at once using
  a nodelist.

Usage: $1 [options] nodelist_file
~~~~~~
       Options are
         -z,--zone number       - number of the zone to test all nodes.
                                  Optional.
         -r,--region number     - number of the region to test all nodes.
                                  Optional.
         -n,--net network       - number of the network to test all nodes,
                                  i.e. 460. Optional.
                                  If you do not specify anything, then the
                                  check will pass through the entire nodelist.
         -o,--one-per-net       - send only one Ping per network.
         -0,--0                 - do not create ping fore nodes with /0 numbers.
         -a,--aka               - do not create ping fore nodes AKA.
         -l,--log log_file_name - file name of log file
         -c,--config            - Configuration file name. Command line options
                                  override it. Needed.
                                  Use command \'fidoping.pl -e > fidoping.conf\'
                                  to create a new one.
         -e,--export            - export config example and exit.
         -t,--test              - test configuration end exit.
         -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 fidoping.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.
         -V,--ver                 show version and exit.
         -w,--whatsnew            show whatsnew.
       

USAGE
	exit;
}

sub export_conf()
{
	print <<ENDCONF;
#  *****************************************************************
#   Configuration file for fidoping.pl by Stas Mishchenkov 2:460/58
#  *****************************************************************
#
msgFromName SysOp Name
#
msgFromAddr 2:9999/9999
#
# optional
msgCHRS CP866
#
pktFrom 2:9999/9999
pktTo   2:9999/9998
#
# pkt password if any. Optional.
password 12345678

# where to create pkt file.
outdir /home/fido/inbound

# optional. no logging if not set.
logfile /home/fido/logs/fidoping.log

# filename with full path to the latest nodelist.
# Wild cards ('*', '?') in the file name may be used.
nodelist /home/fido/nodelist/node*.???

# how to update
# warn, download, no.
update warn
#
# ****************************************************************************

ENDCONF
	exit;
}

sub readconf()
{
	my ( $F, $line, $key );
	return unless defined $configfile;
	unless( open( $F, '<', $configfile ) ) {
		print STDERR "Can't open config file $configfile ($!).";
		exit;
	}
	my $lines = 0;
	while( $line = <$F> ) {
		$lines++;
		$line =~ s/[\r\n]//g;
		$line =~ s/	/ /g;
		next if $line =~ /^\s*[\#\;]/;
		next if $line =~ /^\s+$/;
		next if $line eq '';
		next unless $line =~ /\s*(\S+)\s+(.*?)\s*$/;
		$key = lc($1);
#		unless( defined( $key ) ) {
#			print STDERR "ERROR: in line $lines.\n";
#		}
		if ( defined( $config{$key} ) ) {
			$config{$key} = $2;
		} else {
			print STDERR "ERROR: Unknown config keyword \'$key\' in line $lines.\n";
		}
	}
	close($F);
}

sub test_config()
{
	my ( $key );
	if ( defined( $check_updates ) && $check_updates eq 'f') {
		return;
	}
	unless ( defined( $configfile ) ) {
		print STDERR "Configuration file MUST be defined.\n";
		return;
	}
	print "Testing configuratiun...\n";
	my $errors = 0;
	foreach $key ( keys %config ) {
		if ( $key eq 'msgfromname' ) {
			if ( length( $config{$key} ) > 35  ) {
				print STDERR "ERROR: $key MUST be less or equal 35 bytes.\n";
				$config{$key} = substr( $config{$key}, 0, 35 );
			}
		        print "$key => $config{$key}\n" if defined $testconf;
		} elsif ( $key eq 'msgfromaddr' ) {
			if ( $config{$key} !~ /^\d+\:\d+\/\d+\.?\d*$/ ) {
				print STDERR "ERROR: $key MUST be the 3D or 4D fidonet address.\n";
				$errors++;
			} else {
		        	print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'pktfrom' ) {
			if ( $config{$key} !~ /^\d+\:\d+\/\d+\.?\d*$/ ) {
				print STDERR "ERROR: $key MUST be the 3D or 4D fidonet address.\n";
				$errors++;
			} else {
			        print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'pktto' ) {
			if ( $config{$key} !~ /^\d+\:\d+\/\d+\.?\d*$/ ) {
				print STDERR "ERROR: $key MUST be the 3D or 4D fidonet address.\n";
				$errors++;
			} else {
		        	print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'update' ) {
			if ( $config{$key} !~ /^warn|download|no$/i ) {
				print STDERR "$key MUST be the one of warn|download|no. Will be set to default.\n";
				$config{$key} = 'w';
			}
		        print "$key => $config{$key}\n" if defined $testconf;
		} elsif ( $key eq 'logfile' ) {
			if ( $config{$key} eq '' ) {
				undef $config{$key};
				print STDERR "$key not defined. No logging will be done,\n";
			} else {
			        print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'msgchrs' ) {
			if ( $config{$key} eq '' ) {
				undef $config{$key};
			} else {
			        print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'password' ) {
			if ( $config{$key} eq '' ) {
				print "PKT password not set.\n";
			}
		        print "$key => $config{$key}\n" if defined $testconf;
		} elsif ( $key eq 'nodelist' ) {
			if ( $config{$key} eq '' ) {
				undef $config{$key};
				print STDERR "ERROR: $key MUST be defined.\n";
				undef $config{$key};
				$errors++;
			} else {
			        print "$key => $config{$key}\n" if defined $testconf;
			}
		} elsif ( $key eq 'outdir' ) {
			if ( $config{$key} eq '' ) {
				undef $config{$key};
				print STDERR "ERROR: $key MUST be defined.\n";
				undef $config{$key};
				$errors++;
			} else {
				unless ( -e $config{$key} ) {
					print STDERR "$key $config{$key} does not exist.\n";
					$errors++;
				} else {
			        	print "$key => $config{$key}\n" if defined $testconf;
				}
			}
		}
	}
	exit if $errors > 0;
}

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

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 FidoNet 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 '';
#    print abs_path($ndlpath) . "\n";
    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 = ( stat( $ndlpath . $_ ) )[9];
#		$nldate = -A $ndlpath . $_;
		$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);
    my ($line, $keyword, $name, $phone, $flags, $port, $lport, %port,
        $F, %lport, $nodes, $i, $addr);
    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();
    $start = Time::HiRes::time;
    $zone = $net = $node = 0;
#    $domzone = $domreg = $domnet = $ird = "";
#    $domain = 'binkp.net';
    $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, $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 = ();
	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"};
	    }
	} elsif ($keyword eq "Region") {
	    $region = $net = $node;
	    $node = 0;
	} elsif ($keyword eq "Host") {
	    $net = $node;
	    $node = 0;
	    $domnet = "";
	}
	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;
	if ( $flags =~ /,PING/i ) {
		$nodes++;
#		print sprintf( "%4s ", $nodes ) . "$zone\:$net\/$node\n";
		$name =~ s/_/ /g;
		$nodelist{"$zone\:$net\/$node"} = $name;
	}
   }
    close($F);
    my $lstr = "Nodelist $nldate parsed, $nodes PING-nodes processed (" . sprintf( "%.3f" ,(Time::HiRes::time() - $start) ) . " sec)";
    print( "$lstr\n" );
    writelog( $lstr );
}


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;

    $ver_s = get( $url . 'fidoping.v');
    if (defined ($ver_s) ) {
	if ( $check_updates eq 'f' ) {
		if ( $curpath =~ /^(.*?)\.pl$/ ) {
		    $of = "$1_$ver_s\.pl";
		} elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) {
		    $of = $1 . "fidoping_${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\! \*\*\* ");
		return;
	    } elsif ( $check_updates eq 'd' ) {
		if ( $curpath =~ /^(.*?)\.pl$/ ) {
		    $of = "$1_$ver_s\.pl";
		} elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) {
		    $of = $1 . "fidoping_${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\'.");
	    }
	} else {
	    print "You have actual version.\n";
	    return;
	}
	$upd = get( $url . 'fidoping.pl' );
	unless( defined $upd ) {
	    print STDERR "Can't get update.\n";
	    writelog("Can't get update. ${url}fidoping.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 );
	    print "$of saved.\n\n";
	    chmod 0755, $of if $^O eq 'linux';
	} else {
	    print STDERR "Can't open \'$tmp_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';
}


$0 =~ /([^\\\/]+$)/;
$cmdstr = join(' ', $1, @ARGV);
usage() if $cmdstr eq $1;

GetOptions ("region=s"    => \$lreg,
            "net=s"       => \$lnetw,
#            "fnode=s"     => \$fnode,
            "zone=s"      => \$fzone,
            "config=s"    => \$configfile,
            "test"        => \$testconf,
            "aka"         => \$aka,
            "help"        => \$needhelp,
            "ver"         => \$prinver,
            "whatsnew"    => \$whatsnew,
            "export"      => \$export,
            "update=s"    => \$check_updates,
            "one-per-net" => \$oneping,
            "0"           => \$nozero,
#            "debug"       => \$debug,
#            "brief"       => \$brief,
#            "super-brief" => \$sbrief,
            "log=s"       => \$logfile)  # string
or die("Error in command line arguments\n");

usage() if $needhelp;

if ( $prinver ) {
    print "fidoping.pl $vers.\n";
    exit;
}

if ( $whatsnew ) {
    my $wn = get( $url . 'fidoping.w');
    if( defined( $wn) ) {
	if ( $wn =~ /^$vers/i ) {
	    print $wn;
	} elsif ( $wn =~ /$vers/i ) {
	    print $`;
	} else { print $wn; }
    } else {
	print "Can't get what's new.\n";
    }
    exit;
}

 $ndlfile = shift @ARGV;

 export_conf() if $export;

 readconf();
 test_config();
 exit if defined $testconf;

 undef $config{logfile}  if $config{logfile}  eq '';
 undef $config{nodelist} if $config{nodelist} eq '';
 undef $config{msgchrs}  if $config{msgchrs}  eq '';

 if ( defined($config{logfile}) ) {
	$logfile = $config{logfile} unless defined $logfile;
 }

 if ( defined($config{update}) ) {
	$check_updates = lc( substr( $config{update}, 0, 1 ) ) unless defined $check_updates;
 }

 update();

 unless( defined( $ndlfile ) ) {
	if ( defined( $config{nodelist} ) ) {
		$ndlfile = $config{nodelist};
	} else { usage(); }
 } else { 
#print "ndlfile: \'$ndlfile\'"; 
}

 writelog( $cmdstr );

# findndl( $ndlfile );

 readndl( findndl( $ndlfile ) );

 my ( $messages, $totalpinged, $n, %pinged ) = ( '', 0, undef );

 foreach $n ( sort keys %nodelist ) {

	if( defined( $aka ) && defined( $pinged{$nodelist{$n}} ) ) {
		writelog( "$nodelist{$n} $n already pinged." );
		next;
	}
	if ( $nozero ) {
		$n =~ /\d+\:\d+\/(\d+)/;
		if ( $1 == 0 ) {
			writelog( "Do not create ping to host node $n." );
			next;
		}
	}
	if( $oneping ) {
		$n =~ /\d+\:(\d+)\/\d+/;
		unless( defined( $pingednet{$1} ) ) {
			$pingednet{$1} = 1;
		} else {
			writelog( "Network $1 already pinged." );
			next;
		}
	}

	$messages .= packedmsg( $config{msgfromname}, $msgtoname,
				$config{msgfromaddr}, $n, $attr, $msgtxt,
				$msgsubj, $msgarea, $config{msgchrs} );
	$pinged{$nodelist{$n}} = 1;
	$totalpinged++;
	writelog("Message for $n $nodelist{$n} created.");
 }

 if ( $messages ne '' ) {
	writepkt( $config{outdir}, packpkt( $config{pktfrom}, $config{pktto},
					$config{password}, $messages ) );
	writelog( "Writting pkt done." );
	print "Total $totalpinged nodes pinged.\n";
	writelog( "Total $totalpinged nodes pinged." );
 }

=head1 NAME

  fidoping.pl

=head1 DESCRIPTION

  fidoping.pl is designed to create Ping messages to several nodes at
  once using a nodelist.

  Require https://brorabbit.g0x.ru/files/perl/pkt.pm

=head1 SYNOPSIS


 Usage: fidoping.pl [options] nodelist_file
 ~~~~~~

   nodelist_file            - file name with path of the nodelist. Wild
                              cards ('*', '?') in the file name may be
                              used.
   Options are
     -z,--zone number       - number of the zone to test all nodes.
                              Optional.
     -r,--region number     - number of the region to test all nodes.
                              Optional.
     -n,--net network       - number of the network to test all nodes,
                              i.e. 460. Optional.
                              If you do not specify anything, then the
                              check will pass through the entire
                              nodelist.
     -o,--one-per-net       - send only one Ping per network.
     -0,--0                 - do not create ping fore nodes with /0 numbers.
     -a,--aka               - do not create ping fore nodes AKA.
     -l,--log log_file_name - file name of log file
     -c,--config            - Configuration file name. Command line
                              options overrides it. Needed.
                              Use command 'fidoping.pl -e > fidoping.conf'
                              to create a new one.
     -e,--export            - export config example and exit.
     -t,--test              - test configuration end exit.
     -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 fidoping.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.
     -V,--ver                 show version and exit.
     -w,--whatsnew            show whatsnew.