#!/usr/bin/perl

use strict;
use warnings;

use Parallel::ForkManager;

use Getopt::Long;
use IO::Socket::IP;
use Socket qw(:addrinfo SOCK_RAW);
use LWP::Simple;
use Time::TZOffset qw/tzoffset/;
use Time::HiRes;
use Cwd 'abs_path';
use Time::Local;
#use File::Spec;
use File::Spec::Functions;
use File::Path qw(make_path);
use File::Flock::Tiny;
use File::Copy;
use MIME::Base64;
use IPC::Shareable;
use Net::Whois::Raw;

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

our $myaka = '2:9999/9999.9999';
our $TZUTC = sprintf( "%04d", tzoffset( localtime() ) );

our ( $lreg,$lnetw,$logfile, $fnode, $fzone, $ndlfile, $needhelp,
	$check_updates,$configfile,$export,$flagdir, $debug, $threads, $brief,
	$prinver, $whatsnew, $sbrief, $hostsonly, %ReportTo, @files, $pkt,
	$dated, @lines, $placed, $getfromfile, $nodesfromfile, $ignoredown,
	$override, $rootdomain, $usecalltime );

my $handle = tie @lines, 'IPC::Shareable', { destroy => 'Yes' };

my ( $sysop, $systemname, $location, $NDL ) = ('Evil Robot',
					    $^O, 'Simferopol, Crimea',
					    '-Unpublished-,300,MO' );
our %letters = (
		A => '0000', F => '0500', K => '1000', P => '1500', U => '2000',
                a => '0030', f => '0530', k => '1030', p => '1530', u => '2030',
                B => '0100', G => '0600', L => '1100', Q => '1600', V => '2100',
                b => '0130', g => '0630', l => '1130', q => '1630', v => '2130',
                C => '0200', H => '0700', M => '1200', R => '1700', W => '2200',
                c => '0230', h => '0730', m => '1230', r => '1730', w => '2230',
                D => '0300', I => '0800', N => '1300', S => '1800', X => '2300',
                d => '0330', i => '0830', n => '1330', s => '1830', x => '2330',
                E => '0400', J => '0900', O => '1400', T => '1900',
                e => '0430', j => '0930', o => '1430', t => '1930'
               );

our %ZMH_s = ( '2' => '0230', '#02' => '0230', '!02' => '0230',
               '4' => '0800', '#08' => '0800', '!08' => '0800',
               '1' => '0900', '#09' => '0900', '!09' => '0900',
               '3' => '1700', '#17' => '1700', '!17' => '1700' );

our %ZMH_e = ( '2' => '0330', '#02' => '0330', '!02' => '0330',
               '4' => '0900', '#08' => '0900', '!08' => '0900',
               '1' => '1000', '#09' => '1000', '!09' => '1000',
               '3' => '1800', '#17' => '1800', '!17' => '1800' );


$flagdir = File::Spec->tmpdir();
$threads = 8;

my $arg = '';
foreach ( @ARGV ) {
    $arg .= " $_";
}

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

    my ( $ver_s, $upd, $of, $HANDLE );

    my $curpath = abs_path($0);
    $curpath = Cwd::realpath($0) unless defined $curpath;
    $curpath = Cwd::realpath('./') unless defined $curpath;

    $ver_s = get( $url . 'callip.v');
    if (defined ($ver_s) ) {
	if ( $check_updates eq 'f' ) {
		if ( $curpath =~ /^(.*?)\.pl$/ ) {
		    $of = "$1_$ver_s\.pl";
		} elsif ( $curpath =~ /^(.*?[\/\\])[^\/\\]+$/ ) {
		    $of = $1 . "callip_${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 . "callip_${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 . 'callip.pl' );
	unless( defined $upd ) {
	    print STDERR "Can't get update.\n";
	    writelog("Can't get update. ${url}callip.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';
}

GetOptions ("region=s"    => \$lreg,
            "net=s"       => \$lnetw,
            "fnode=s"     => \$fnode,
            "zone=s"      => \$fzone,
            "0"           => \$hostsonly,
            "override"    => \$override,
            "get-from-file=s" => \$getfromfile,
            "placed"      => \$placed,
            "config=s"    => \$configfile,
            "aka=s"       => \$myaka,
            "help"        => \$needhelp,
            "ver"         => \$prinver,
            "whatsnew"    => \$whatsnew,
            "export"      => \$export,
            "update=s"    => \$check_updates,
            "brief"       => \$brief,
            "super-brief" => \$sbrief,
            "dated"       => \$dated,
            "ignore"      => \$ignoredown,
            "time"        => \$usecalltime,
            "log=s"       => \$logfile)  # string
or die("Error in command line arguments\n");

if ( $prinver ) {
    print "Current version $vers.\n";
    $check_updates = 'w';
    update();
    exit;
}

$sbrief = 1 if $dated;
$brief = 1 if $sbrief;
if ( defined( $lnetw ) || defined( $fnode ) ) {
    undef $hostsonly;
    print "-0 does not make sense if a host or network number is specified.\n" if defined $hostsonly;
}

if ( $whatsnew ) {
    my $wn = get( $url . 'callip.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;

our ( %nodelist, %sortednodes, $nldate, %sysopname, %calltime );

sub help
{
    print "\nCalls the specified nodes by the binkp protocol, using connect information\n".
	  "from the nodelist.\n\n".
	  "Usage: $0 [options] nodelist_file_name\n".
	  "~~~~~\n".
	  "         -f,--fnode address     - address (3D, 4D or 5D) of the node to call.\n".
	  "                                  An address list in quoters may be used.\n".
	  "                                  i.e. --fnode=\"addr1 addr2 addr3\". Optional.\n".
	  "         -z,--zone number       - number of the zone to test all nodes.\n".
	  "                                  Optional.\n".
	  "         -r,--region number     - number of the region to test all nodes.\n".
	  "                                  Optional.\n".
	  "         -n,--net number        - number of the network to test all nodes,\n".
	  "                                  i.e. 460. Optional.\n".
	  "                                  If you do not specify anything, then the\n".
	  "                                  check will pass through the entire nodelist.\n".
	  "         -0                     - call nodes only with a zero number.\n".
	  "         -g,--get-from-file filename\n".
	  "                                - Get the list of nodes to call from the file.\n".
	  "                                  The file must contain a list of 3D node\n".
	  "                                  addresses separated by any of the following\n".
	  "                                  characters: space, tab, or line feed, with or\n".
	  "                                  without carriage return. Also you can mix this\n".
	  "                                  option with --fnode=\"addr1 addr2 addr3\".\n".
	  "         -c,--config            - Configuration file name. Command line options\n".
	  "                                  override it. Optional. Not needed by default.\n".
	  "                                  Use command \'callip.pl -e > callip.conf\' to\n".
	  "                                  create a new one.\n".
	  "         -o,--override          - Override DNS lookups by Root-Domain. i.e. if\n".
	  "                                  node fly IBN flag but have no any connection\n".
	  "                                  information Root-Domain will be used.\n".
	  "                                  Root-Domain MUST be defined by configuration\n".
	  "                                  file.\n".
	  "         -l,--log log_file_name - file name of log file\n".
	  "         -p,--placed            - use WhoIs info to put in a log where the nodes\n".
	  "                                  IP address placed\n".
	  "         -b,--brief             - brief log.\n".
	  "         -s,--super-brief       - super brief log.\n".
	  "         -d,--dated             - create from super brief log dated file,\n".
	  "                                  sorted by node.\n".
	  "                                  May be used with --super-brief option only.\n".
	  "         -a,--aka address       - the fido address from which to make calls.\n".
	  "                                  Optional. default is \'$myaka\'.\n".
	  "                                  It is strongly recommended not to use\n".
	  "                                  an existing address here.\n".
	  "         -i,--ignore            - ignore Hold and Down status.\n".
	  "         -t,--time              - use node's call time\n".
	  "         -e,--export            - export configuration and exit.\n".
	  "         -u,--update            - How to update the program. Optional.\n".
	  "                                  =d - download. Check for a new version and\n".
	  "                                       download the update to a new file.\n".
	  "                                  =f - Force download callip.pl end exit even\n".
	  "                                       if no new version is found.\n".
	  "                                  =w - warn. Check for a new version and warn\n".
	  "                                       the sysop. Default.\n".
	  "                                  =n - no. Do nothing.\n".
	  "         -V,--ver                 show version and exit.\n".
	  "         -w,--whatsnew            show whatsnew.\n";
    exit;
}

sub readconf
{
    my ( $line );
    unless( open( CFG, "<$configfile" ) ){
	print "Can't open $configfile. ($!)\n";
	return;
    }
    while( $line = <CFG> ) {
	$line =~ s/	/ /g;
	$line =~ s/^\s+//g;
	$line =~ s/[ ]{2,}/ /g while $line =~ /[ ]{2,}/;
	$line =~ s/[\r\n]//g;
	next if $line =~ /^[\#\:\;]/;
	if( $line =~ /^sysop (.*?)$/i ){
	    $sysop = $1;
	} elsif ( $line =~ /^sysname (.+)$/i ){
	    $systemname = $1;
	} elsif ( $line =~ /^address (.+)$/i ){
	    $myaka = $1;
	} elsif ( $line =~ /^location (.+)$/i ){
	    $location = $1;
	} elsif ( $line =~ /^nodeinfo (.+)$/i ){
	    $NDL = $1;
	} elsif ( $line =~ /^nodelist ([^ ]+)$/i ){
	    $ndlfile = $1 unless defined $ndlfile;
	} elsif ( $line =~ /^log ([^ ]+)$/i ){
	    $logfile = $1 unless defined $logfile;
	} elsif ( $line =~ /^flags ([^ ]+)$/i ){
	    $flagdir = $1;
	} elsif ( $line =~ /^update ([^ ]+)$/i ){
	    $check_updates = $1 unless defined $check_updates;
	    $check_updates =~ s/^([a-z]{1}).*$/$1/i;
	    $check_updates = lc($check_updates);
	} elsif ( $line =~ /^threads (\d+)/i ){
	    $threads = $1;
	} elsif ( $line =~ /^ReportTo (\d+\:\d+\/\d+) ([^ ]+) ?([^ ]*)/i ){
	    ($ReportTo{addr},$ReportTo{pwd},$ReportTo{area}) = ($1,$2,$3);
	} elsif ( $line =~ /^root-domain ([^ ]+)/i ){
	    $rootdomain = $1;
	}
	
    }
}

sub exportcfg
{
	print "\# callip\.pl configuration\.\n#\n".
	"# SyOp Name\n".
	"SysOp $sysop\n#\n".
	"# System Name\n".
	"SysName $systemname\n#\n".
	"# 4D or 5D fido address\n".
	"# It is strongly recommended not to use an existing address here.\n".
	"Address $myaka\n#\n".
	"# Where are you from\n".
	"location $location\n#\n".
	"# Phone number, modem speed, nodelist flags\n".
	"nodeinfo $NDL\n#\n".
	"# Nodelist file name. * and ? may be used.\n".
	"#nodelist /home/fido/nodelist/*list.???\n".
	"#nodelist /home/fido/nodelist/nodelist.367\n#\n".
	"# log file name\n".
	"#log /home/fido/logs/callip.log\n#\n".
	"# busy flags dir name.\n".
	"#flags /home/fido/flags\n#\n".
	"#\n".
	"# Overrides root domain for DNS lookups.\n".
	"root-domain binkp.net\n".
	"#\n".
	"# How to update the program.\n".
	"# auto = Check for a new version, download and update.\n".
	"# download = Check for a new version and download the update to a new file.\n".
	"# force = Force download callip.pl end exit even if no new version is found.\n".
	"# warn = Check for a new version and warn the sysop. Default.\n".
	"# no = Do nothing.\n".
	"update warn\n#\n".
	"# How many threads use to call nodes. Default 8.\n".
	"threads 8\n#\n".
	"# Send log as report to a node with password (use \"-\" if no any) in area\n".
	"# (by netmail if not defined).\n".
	"#ReportTo 2:460/58 password ECHO.AREA\n#\n";
	exit;
}

sub getplace($)
{
   my ( $domain ) = @_;
   my $dominfo = whois($domain);
   
   my $city = $1 if $dominfo =~ /contact\:City\:([^\r\n]+)[\r\n]+/i;
   my $province = $1 if $dominfo =~ /contact\:Province\:([^\r\n]+)[\r\n]+/i;
   my $country = $1 if $dominfo =~ /contact\:Country-Code\:([^\r\n]+)[\r\n]+/i;
   unless( defined($country) ){
       $country = $1 if $dominfo =~ /country\:[     ]*([^\r\n]+)[\r\n]+/i;
   }
   my $rc = ' ';
   $rc .= $city if defined $city;
   $rc .= " $province" if defined $province;
   $rc .= " $country" if defined $country;
   undef $rc if $rc eq ' ';
   return $rc;
}

sub sendaspkt($;$$$$$$)
{
    print "Sending as PKT...\n";
    my ($msg_fromname, $msg_toname, $msg_fromaddr, $msg_toaddr, $msg_txt,
    $msg_subj, $msg_area ) = @_;
    
    if (length($msg_fromname) > 35){
	$msg_fromname = substr($msg_fromname,0,35);
    }
    $msg_fromname .= "\000";
    if (length($msg_toname) > 35){
	$msg_toname = substr($msg_toname,0,35);
    }
    $msg_toname .= "\000";
    if (length($msg_subj) > 71){
	$msg_subj = substr($msg_subj,0,71);
    }
    $msg_subj .= "\000";

    $myaka =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    my ( $pkt_origzone, $pkt_orignet, $pkt_orignode, $pkt_origpnt ) = ( $1, $2, $3, $4 );
    $pkt_origpnt = 0 if !defined $pkt_origpnt;
    
    $msg_toaddr =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    my ( $pkt_destzone,$pkt_destnet,$pkt_destnode,$pkt_destpnt ) = ( $1,$2,$3,$4 );
    $pkt_destpnt = 0 if !defined $pkt_destpnt || $pkt_destpnt eq '';
    my $password = $ReportTo{pwd};
    $password .= "\x00" while length($password) < 8;
    localtime =~ /[a-z]+ ([a-z]+)[ ]+(\d+) (\d+)\:(\d+)\:(\d+) \d\d(\d\d)/i;
    my $DateTime = sprintf("%02s", $2)." $1 $6  $3:$4:$5\000";

    my ($second,$minute,$hour,$day,$month,$year,$wday,$yday,$isdst) = localtime();
    $year = $year + 1900;
    $yday++;

    my ($pkthdr,$msgheader,$m_txt);

    $msg_fromaddr =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    
    my ( $msg_origzone, $msg_orignet, $msg_orignode, $msg_origpnt ) = ( $1, $2, $3, $4 );
    $msg_origpnt = 0 if !defined( $msg_origpnt ) || $msg_origpnt eq '';

    $msg_toaddr =~ /(\d+)\:(\d+)\/(\d+)\.?(\d*)/;
    my ($msg_destzone,$msg_destnet,$msg_destnode,$msg_destpnt) = ( $1, $2, $3, $4 );
    $msg_destpnt = 0 if !defined($msg_destpnt) || $msg_destpnt eq '';

    $pkthdr = pack("S2S3S3 S2S2 C2A8S2S2 C2SS4I", $pkt_orignode,
    $pkt_destnode,$year,$month,
    $day,$hour,$minute,$second,0,2,$pkt_orignet,$pkt_destnet,3,3,
    $password,$pkt_origzone,$pkt_destzone,0, 0x0100,3,3,0x0001,
    $pkt_origzone,$pkt_destzone,$pkt_origpnt,$pkt_destpnt, 0 );

    $msgheader = pack( "S7Z20", 2,$msg_orignode,$msg_destnode,
    $msg_orignet,$msg_destnet,0,0,$DateTime ) . $msg_toname .
    $msg_fromname . $msg_subj;

    undef $msg_area if $msg_area eq '';
    $m_txt = "AREA:$msg_area\r" if defined($msg_area);
    $m_txt .= "\001MSGID: $msg_fromaddr ".sprintf("%08x", time())."\r\001TZUTC $TZUTC\r";
    
# NO INTL in Echmail permitted
    $m_txt .= "\001INTL $msg_destzone:$msg_destnet/$msg_destnode $msg_origzone:$msg_orignet/$msg_orignode\r" if !defined $msg_area;
    $m_txt .= "\001FMPT $msg_origpnt\r" if $msg_origpnt != 0;
    $m_txt .= "\001TOPT $msg_destpnt\r" if $msg_destpnt != 0 && !defined $msg_area;
    $msg_fromaddr =~ /(\d+\:\d+\/\d+\.?\d*)/;
    $msg_txt .= "\r--- \r \* Origin: callip.pl \($1)\r";

    my ( $g_sec, $g_min, $g_hour, $g_mday,$g_month,$g_year) = (gmtime)[0...5];
    if ( defined( $msg_area ) ) {
    if ( $pkt_origpnt == 0 ) {
        $msg_txt .= "SEEN\-BY: $msg_orignet\/$msg_orignode $pkt_destnet\/$pkt_destnode\r".
	    "\x01PATH: $msg_orignet\/$msg_orignode\r";
    }
    } else {
	$msg_txt .= sprintf("\x01Via $myaka \@%04d%02d%02d\.%02d%02d%02d\.UTC callip.pl $vers\r",
	$g_year+1900, $g_month+1, $g_mday, $g_hour, $g_min, $g_sec );
    }
    $msg_txt .= "\000\000\000";

print "Done.\n";
return "$pkthdr$msgheader$m_txt$msg_txt";
}


sub oldbsy()
{
 my $bsyf;
    if ( opendir( DH, $flagdir ) ) {
	print "Reading $flagdir...\n" if $debug;
	while( readdir( DH ) ) {
	    if( $_ =~ /\.busy$/i ) {
		print "$_\n" if $debug;
		$bsyf = File::Spec->catfile( $flagdir, $_ );
		if ( unlink( $bsyf ) ) {
		    print "found $_ and deleted.\n";
		    writelog("found $_ and deleted.\n");
		} else {
		    print STDERR "Can't delete $bsyf ($!).\n";
		    writelog( "ERROR: Can't delete $bsyf ($!).\n" );
		}
	    }
	}
	close( DH );
    } else {
	print STDERR "Can't open $flagdir ($!).\n";
	writelog("ERROR: Can't open $flagdir ($!).\n");
    }
}

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 );
    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.$rootdomain";
		$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();
}

our ( $M_NUL, $M_ADR, $M_PWD, $M_OK, $M_FILE, $M_EOB, $M_GOT, $M_ERR, $M_BSY,
     $M_GET, $M_SKIP ) = ( "\x00", "\x01", "\x02", "\x04", "\x03", "\x05", 
     "\x06", "\x07", "\x08", "\x09", "\x0a");

sub readblock($)
{
  my ($sock) = @_;

  my ( $iscmd, $cmd, $cmdlen, $data, $remoteaddr, $readresult, $starttime );

    print "reading first byte\n" if $debug;
    $sock->timeout(15);
    $readresult = sysread($sock, $iscmd, 1 );
    return ('Error', 'Socket read error.' ) unless $readresult;
    $iscmd = ord($iscmd);
    if ( $iscmd < 128 ) {
#	print "reading second byte\n" if $debug;
	return ('Error', "Socket read error." ) unless sysread($sock, $cmdlen, 1 ) == 1;
	$cmdlen = ord($cmdlen);
	$cmdlen = ( $iscmd * 256 ) + $cmdlen;
	$readresult = 0;
	$starttime = time();
	while ( $readresult < $cmdlen ) {
	    $readresult += sysread($sock, $data, $cmdlen );
	    if ( (time()-$starttime) > 30 ) {
		return ('Error', "Socket read error." );
	    }
	}
	return ('DATA', $data);
    } else {
	print "reading second byte\n" if $debug;
	return ('Error', "Socket read error ($!)." ) unless sysread($sock, $cmdlen, 1 ) == 1;
	$cmdlen = ( ord($cmdlen) + ( ( $iscmd - 128 ) * 256) );
	return ('Error', "Socket read error.($!)" ) unless sysread($sock, $cmd, 1 ) == 1;
	
	$readresult = 0;
	$starttime = time();
	while ( $readresult < $cmdlen - 1 ) {
	    $readresult += sysread($sock, $data, $cmdlen - 1 );
	    if ( (time()-$starttime) > 30 ) {
		return ('Error', "Socket read error." );
	    }
	}
#	return ('Error', "Socket read error.($!)" ) unless sysread($sock, $data, $cmdlen - 1 ) == $cmdlen - 1;
	return ($cmd,$data);
    }

}


sub connec2binkd($$$$)
{
  my ($host,$portaddress,$fn,$hostname) = @_;
  my $rc = '';
  my ($sock,$s,@bsyflag,@pid,$l,$wait_mgot,$wait_mok);
  my $isbinkd = "Error! No binkp found\n";
  my $place;
  
  $place = getplace($host) if $placed;
  $place = '' unless defined $place;
  
#  writelog("***Calling $fn ($host:$portaddress)***") if $debug;
  $rc = "$fn\t$hostname\:$portaddress" if $sbrief;
  
  localtime() =~ /([^ ]+) ([^ ]+)[ ]+(\d+) (\d\d\:\d\d:\d\d) (\d\d\d\d)/;
  my ( @str ) = ( 
	"SYS $systemname",
	"ZYZ $sysop",
	"LOC $location",
	"NDL $NDL",
	"TIME $1 $3 $2 $5 $4 $TZUTC",
	"VER Call_Robot/$vers/$^O binkp/1.0"
	);

  print "Calling $fn ($host\:$portaddress)$place\n";
  $rc .= "     ($host\:$portaddress) $place\n" unless $brief;
  
  $fn =~ /(\d+)\:(\d+)\/(\d+)/;
  @bsyflag = ( File::Spec->catfile( $flagdir, "$1.$2.$3.0.busy" ) );
  while( -e $bsyflag[0] ) {
    print "$fn is busy\n";
    sleep 1;
  }
  $pid[0] = File::Flock::Tiny->write_pid( $bsyflag[0] ) or do {
    print "$fn is busy. Sleep 1 sec.\n";
    sleep 1;
  };

  $sock = IO::Socket::IP->new( PeerAddr => $host,
    PeerPort => $portaddress,
    Timeout  => 15,
    Proto    => 'tcp') or do {
		print( "error \($@\)\n" );
		$pid[0]->release if defined $pid[0];
		unlink( @bsyflag );
		$rc .= "  $host - Error: $@\n" unless $sbrief;
		$rc .= "\t$host$place\tError: $@\n" if $sbrief;
		return( $rc );
    };
    if( $sock == 0 ) {
	print( "Error: Can't connect to $host:$portaddress\n" );
	unlink( @bsyflag );
	$rc .= "	$host$place	- Error: $!\n";
	return( $rc );
    }
    print "$host Sending our info...\n" if $debug;
#    writelog( "$fn ($host) Sending our info...\n" ) if $debug;
    foreach $s ( @str ) {
	unless( syswrite($sock, "\x80" . chr(length($s) + 1) . $M_NUL . $s) ) {
	    unlink( @bsyflag );
	    $rc .= "Socket write error!\n";
	    close($sock);
	    return $rc;
	}
    }
    unless( syswrite($sock, "\x80" . chr(length($myaka) + 2) . "$M_ADR $myaka") ){
	unlink( @bsyflag );
	$rc .= "Socket write error!\n";
	close($sock);
	return $rc;
    }
# set password...
    my $password = '-';
    if ( defined( $ReportTo{addr} ) ) {
	$password = $ReportTo{pwd} if defined( $ReportTo{pwd} ) && $fn eq $ReportTo{addr};
    }
    
    unless( syswrite($sock, "\x80".chr(length($password)+1)."$M_PWD$password") ) {
	unlink( @bsyflag );
	$rc .= "Socket write error!\n";
	close($sock);
	return $rc;
    }
# set traff...
    my ($mtrf,$ftrf) = (0,0);
    if( defined( $files[0] ) ) {
	print "$files[0]\n";
	$files[0] =~ /[^ ]+ (\d+) \d+ \d+/;
	$mtrf = $1;
    }
    my $alltrf = "TRF $mtrf $ftrf";

    unless( syswrite($sock, "\x80" . chr( length( $alltrf ) + 1 ) . "${M_NUL}${alltrf}") ) {
	foreach $l ( @pid ) {
	    $l->release if defined $l;
	}
	unlink( @bsyflag );
	return "Socket write error!\n";
    }

    print "Waiting M_OK...\n" if $debug;

    WAITOK:
    my ($c,$d) = readblock($sock);
    print localtime()."\n" if $debug;
    if ( $c eq "DATA" ) {
	print "DATA not expected now!\n\'$c\', \'$d\'\n";
	$s = 'Not expected DATA!';
	$rc .= " $s\n \'$c\'\, \'$d\'\n$isbinkd";
	goto WAITOK;
    }elsif( $c eq 'Error') {
	print "$c $d\n";
	close($sock);
	unlink @bsyflag;
	$rc .= " $c\: $d\n" unless $sbrief;
	$rc .= "\t$host$place\t$c\: $d\n" if $sbrief;
	return $rc;
    } else {
	if ($c eq $M_NUL) {
	    print "$d\n";
#	    if ( $d =~ /^OPT CRAM\-MD5\-(.*)$/ ) {
#		print( decode_base64($1) );
#	    }
	    $rc .= " $d\n" unless $brief;
	    if( $d =~ m@(binkp/1.[01])@i ) {
		$isbinkd = '';
	    }
	    goto WAITOK;
	} elsif ($c eq $M_ADR) {
	    my $is = 0;
	    $rc .= "M_ADR \'$d\' \n" if $debug;
	    $d =~ s/^ //;
	    $d =~ s/\x00$//;
	    foreach my $ma ( split(' ',$d) ) {
		print "address: $ma\n";
		$rc .= " address: $ma\n" unless $brief;
		$is = 1 if $ma =~ /^$fn(\.0)?(\@[a-zA-z\.0-9\-]+)?$/i;
		$ma =~ /(\d+)\:(\d+)\/(\d+)/;
		@bsyflag = ( @bsyflag, File::Spec->catfile( $flagdir, "$1.$2.$3.0.busy" ) );
		@pid = ( @pid, File::Flock::Tiny->write_pid( $bsyflag[0] ) ) or do {
		    print( "$host is busy. Sleep 1 sec.\n" );
		    sleep 1;
		};
	    }
	    if ($is == 0) {
		print "No such AKA.\n$isbinkd";
		$rc .= " No such AKA.\n" unless $sbrief;
		$rc .= "\t$host$place\tNo such AKA.\n" if $sbrief;
		$rc .= "Socket write error!\n" unless syswrite($sock, "\x80\x0d${M_ERR}No such AKA.");
		$rc .= "Socket write error!\n" unless syswrite($sock, "\x80\x01${M_EOB}");
		close($sock);
		unlink @bsyflag;
		return $rc;
	    }
	    goto WAITOK;
	} elsif ($c eq $M_ERR) {
	    print "Got binkp error: $d.\n";
	    $rc .= " $host$place - Got binkp error: $d.\n";
	    $rc .= "Socket write error!\n" unless syswrite($sock, "\x80\x01${M_EOB}");
	    close($sock);
	    unlink @bsyflag;
	    return $rc;
	} elsif ($c eq $M_BSY) {
	    print "Error: $d.\n";
	    $rc .= " $host$place - Got error: $d.\n";
	    $rc .= " Socket write error!\n" unless syswrite($sock, "\x80\x01${M_EOB}");
	    close($sock);
	    unlink @bsyflag;
	    return $rc;
	} elsif ($c eq $M_FILE) {
	    $d =~ /^([^ ]* \d+ \d+) \d+$/;
	    syswrite($sock, "\x80".chr( length($1)+1 )."${M_SKIP}$1");
	    print "File $d skipped.";
	    $rc .= " $fn have a file $d for us.\n";
	} elsif ($c eq $M_OK) {
	    print " $host - Ok.\n";
	    $rc .= "  $host$place - Ok.\n" unless $sbrief;
	    $rc .= "\t$host$place\tOk.\n" if $sbrief;
	}
    }
    $wait_mok = 0;
    if( defined( $files[0] ) ) {
	foreach my $fff ( @files ) {
	    print "Sending file $fff...\n";
	    writelog("Sending file $fff...");
	    syswrite($sock, "\x80". chr(length( $fff ) + 1) ."${M_FILE}${fff}");
	    my ( $lll, $ofset, $www ) = ( length($pkt), 0, 0 );
	    while( $ofset < $lll ){
		$www = substr( $pkt, $ofset, 4096 );
		my $wll = length($www);
		$ofset += $wll;
		my $fb = int( $wll/256 );
		my $sb = $wll - ( $fb * 256 );
		syswrite($sock, chr( $fb ) . chr( $sb ) . $www );
	    }
	    $wait_mgot = 0;
	    while( $wait_mgot == 0 ) {
		($c,$d) = readblock($sock);
		if ( $c eq $M_GOT ) {
		    $wait_mgot = 1;
		    $d =~ /([^ ]+) (\d+) \d+/;
		    print "file $1 ($2 bytes) sent to $fn.\n";
		    writelog("file $1 ($2 bytes) sent to $fn.");
		} elsif ( $c eq $M_EOB ) {
		    $wait_mok = 1;
		} elsif ($c eq $M_NUL) {
		    print "$d\n";
		    $rc .= "$d\n" unless $brief;
		} elsif ($c eq $M_FILE) {
		    $d =~ /^([^ ]* \d+ \d+) \d+$/;
		    syswrite($sock, "\x80".chr( length($1)+1 )."${M_SKIP}$1");
		    print "File $d skipped.\n";
		    $rc .= "File $d skipped.\n";
		}
	    }
	}
    }

    unless( syswrite($sock, "\x80\x01${M_EOB}") ) {
	foreach $l ( @pid ) {
	    $l->release if defined $l;
	}
	unlink( @bsyflag );
	return "Socket write error!\n";
    }
    
    print( "Waiting M_EOB\n" ) if $debug;
    writelog( "Waiting M_EOB\n" ) if $debug;
    while( $wait_mok == 0 ) {
        ($c,$d) = readblock($sock);
	if ($c eq $M_NUL) {
	    print "$d\n";
	    $rc .= "$d\n" unless $brief;
	} elsif ($c eq $M_FILE) {
	    $d =~ /^([^ ]* \d+ \d+) \d+$/;
	    syswrite($sock, "\x80".chr( length($1)+1 )."${M_SKIP}$1");
	    print "File $d skipped.\n";
	    $rc .= "File $d skipped.\n";
	} elsif ($c eq $M_EOB) {
	    print "Session with $fn done.\n";
	    $rc .= "Session with $fn done.\n" unless $brief;
	    $wait_mok = 1;
	} else {
	    print "\'$c\'\n";
	    $rc .= "\'$c\',\'$d\'\n";
	}
    }
  close($sock);
  foreach $l ( @pid ) {
    $l->release if defined $l;
  }
  unlink @bsyflag;
  return $rc;
}

sub writelog
{
    my ( $str ) = @_;
    return unless defined $logfile;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    $str =~ s/([\r\n])$//;
    sprintf("%.3f",Time::HiRes::time) =~ /([\.\,]\d+)$/;
    my $startstr = ($year+1900)."-". sprintf("%02d",$mon+1)."-". 
	sprintf("%02d",$mday)." ". sprintf("%02d",$hour).":".
	sprintf("%02d",$min).":". sprintf("%02d",$sec)."$1 ";
    $str =~ s/([\r\n]+)/$1$startstr/g;
    if ( open( FLOG, ">>$logfile") ) {
	syswrite( FLOG, "${startstr}$str\n" );
	close( FLOG );
    } else {
        printf( STDERR "Can't open $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 \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 testcall($$$)
{
    my ( $hostname, $portaddress, $fn ) = @_;
    print "Resolving host name...\n" if $debug;
    writelog("Resolving host name...\n") if $debug;
    my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW});
    my $r = '';
    if ( $err ) {
	$r = " Error: Cannot getaddrinfo - $err\n" unless $sbrief;
	$r = "$fn\t$hostname\t-\tError: Cannot getaddrinfo - $err" if $sbrief;
	return $r;
    }

    while( my $ai = shift @res ) {
	my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
	if ( $err ) {
	    $r .= " Cannot getnameinfo - $err\n" unless $sbrief;
	    $r .= "\t$fn\t$hostname\:$portaddress\tCannot getnameinfo - $err" if $sbrief;
	    undef $err;
	    next;
	}
	$r .= connec2binkd($ipaddr,$portaddress,$fn,$hostname);
    }
    return $r;
}

sub callnode($)
{
    my ($fn) = @_;
#    writelog("xxx Calling node $fn xxx") if $debug;
    my ( $hostname, $portaddress, $r, $bsyflag, $pid, $nowutc );
    
    $nowutc = sprintf( "%02d%02d", (gmtime())[2], (gmtime())[1] );
    $r = "Calling $fn\n" unless $sbrief;
    print "Calling \'$fn\'.";
    print " Call time: \'$calltime{$fn}{s}\-$calltime{$fn}{e}\' UTC.\n";
#    $r .= " Call time: \'$calltime{$fn}{s}\-$calltime{$fn}{e}\' UTC. " unless $sbrief;
#    gmtime() =~ /[a-z]+ [a-z]+ \d\d (\d\d):(\d\d):\d\d \d\d\d\d/i;
    print " Now is: $nowutc UTC.\n";
    if ( defined( $usecalltime ) ) {
	unless ( $nowutc gt $calltime{$fn}{s} && $nowutc le $calltime{$fn}{e} ) {
	    print " Nothing to do.\n";
	    $r .= "$fn	Call Time:	$calltime{$fn}{s}\-$calltime{$fn}{e} UTC	" if $sbrief;
	    $r .= "Now isn't a call time.\n";
	    return $r;
	}
    }
    foreach my $d ( split( ';', $nodelist{$fn} ) ) {
	undef $portaddress;
        if ( $d =~ /^(.+?)[\.\]]?\:+(\d+)\.?$/ ) {
	    ( $hostname, $portaddress ) = ($1, $2);
	} else {
	    $d =~ /(.*?)\.?$/;
	    $hostname = $1;
	}
	$portaddress = '24554' unless defined $portaddress;
	print "$hostname, $portaddress\n";
	$r .= " $hostname\:$portaddress\n" unless $sbrief;
	if( defined( $flagdir ) ) {
	    $bsyflag = File::Spec->catfile($flagdir, "$hostname\-$portaddress\.busy");
	    while( -e $bsyflag ) {
		print( "$hostname is busy. Sleep 1 sec.\n" );
		sleep 1;
	    }
	    $pid = File::Flock::Tiny->write_pid( $bsyflag ) or do {
		print( "$hostname is busy. Sleep 1 sec.\n" );
		sleep 1;
	    }
	}

	$r .= testcall($hostname, $portaddress, $fn);
	if( defined $bsyflag ) {
	    $pid->release if defined $pid;
	    unlink $bsyflag;
	}
    }
    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);
}

sub createdated()
{
    my ( $line, $l );
    my $logpath = abs_path( $logfile );
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
    $logpath =~ /^(.*?)[^\\\/]+$/;
    $logpath = File::Spec->catfile( $1, sprintf("%04d%02d%02d.log", ($year+1900), ($mon+1),$mday) );

    unless( open( FLS, ">$logpath" ) ){
	print STDERR "Can't write \'$logpath\' ($!).\n";
	exit;
    }
    foreach $l ( sort nodesort @lines ){
	$l =~ s/[\r\n]$//;
	print FLS "$l\n";
    }
    close(FLS);
    IPC::Shareable->clean_up_all;
}

sub readnodesfromfile()
{
#$getfromfile, $nodesfromfile
   unless( open( NFH, "<$getfromfile" ) ) {
       print STDERR "Can't open \'$getfromfile\' ($!).\n";
       exit;
   }
   unless ( read( NFH, $nodesfromfile, -s NFH ) ) {
       print STDERR "Can't read \'$getfromfile\' ($!).\n";
       exit;
   }
   close(NFH);
   $nodesfromfile =~ s/[\r\n]/ /g;
   $nodesfromfile =~ s/\t/ /g;
   $nodesfromfile =~ s/  / /g while $nodesfromfile =~ /  /;
   $nodesfromfile =~ s/^ //g;
   $nodesfromfile =~ s/(\d+\:\d+\/\d+)\.\d+/$1/g;
   $nodesfromfile =~ s/ /\,/g;
#   $nodesfromfile .= ',';
   $nodesfromfile =~ s/[^\d\:\/\.\,]//g;
   $nodesfromfile =~ s/\,\,/\,/g while $nodesfromfile =~ /\,\,/;
   foreach my $no ( split( /\,/, $nodesfromfile )  ){
	unless( defined( $nodelist{$no} ) ) {
	    print "Node $no not found.\n";
	    writelog("Node $no not found.");
	}
   }

#   print "$nodesfromfile\n";
#   exit;
}

exportcfg() if defined $export;
help() if defined $needhelp;
if( defined( $check_updates ) && ( !defined( $ndlfile ) || !defined( $configfile ) ) ) {
    update();
    exit();
}
readconf() if defined $configfile;

writelog("callip.pl $vers. $arg");
$flagdir = File::Spec->catdir( $flagdir, 'callip.flags' );
make_path( $flagdir ) unless -e $flagdir;

oldbsy();
$check_updates = 'w' unless defined( $check_updates );
update();
help() unless defined( $ndlfile ) || defined( $configfile );

if ( $override ){
    unless ( defined( $rootdomain ) ) {
	print STDERR "Root-Domain MUST be defined to override DNS lookups.\n";
	exit;
    }
}

readndl( findndl( $ndlfile ) );
readnodesfromfile() if defined $getfromfile;

if ( defined( $fnode ) ) {
   $fnode =~ s/(\d+\:\d+\/\d+)\.\d+/$1/g while $fnode =~ /(\d+\:\d+\/\d+)\.\d+/;
   $fnode =~ s/([^\d+\:\d+\/\d+ \,])//g;
   if ( $fnode =~ /\d+\:\d+\/\d+[ \,]+\d+\:\d+\/\d+/ ) {
        unless ( defined( $nodesfromfile ) ) {
	    $nodesfromfile = $fnode;
	} else {
	    $nodesfromfile .= $fnode;
	}
	$nodesfromfile =~ s/\s/\,/g;
	$nodesfromfile =~ s/\,\,/\,/g while $nodesfromfile =~ /\,\,/;
	undef $fnode;
   }
}

my ( @th, @joinable, $jo, $the, $sname, $lline, $nn );
    unless ( defined $fnode ) {
	my $pm = Parallel::ForkManager->new( $threads );
	if( defined( $nodesfromfile ) ) {
#		if index( $nodesfromfile, "$nn\," ) == -1 );
	    CALLNODES:
	    foreach $nn (sort split( ',', $nodesfromfile) ) {
		$pm->start and next CALLNODES;
	        if( defined( $nodelist{$nn} ) ) {
		    $lline = callnode($nn);
		} else {
		    $lline = "Node $nn not found.";
		}
		$handle->shlock();
		push @lines, $lline;
		$handle->shunlock();
		writelog( $lline );
		$pm->finish;
	    }
	} else {
	    CALLALL:
	    foreach $nn (sort keys %nodelist) {
		$pm->start and next CALLALL;
		$lline = callnode($nn);
		$handle->shlock();
		push @lines, $lline;
		$handle->shunlock();
		writelog( $lline );
		$pm->finish;
	    }
	}
	$pm->wait_all_children;
    } else {
	if( defined( $nodelist{$fnode} ) ) {
	    $lline = callnode($fnode);
	    writelog( $lline );
	} else {
	    print "Node $fnode not found.\n";
	    writelog("Node $fnode not found.");
	}
    }

    if ( $sbrief && $dated ) {
	createdated();
    }

    if( defined( $ReportTo{addr} ) ) {
    	undef $hostsonly;
	undef $fzone;
	undef $lreg;
	undef $lnetw;

	unless( open( FLS, "<$logfile" ) ){
	    print STDERR "Can't read \'$logfile\' ($!).\n";
	    exit;
	}
	my $lsi = -s FLS;
#	print "log size = \'$lsi\'\n";
	sysread( FLS, $pkt, $lsi );
	close(FLS);
	$pkt =~ s/\n/\r/g;
	if ( defined( $ReportTo{area} ) && $ReportTo{area} ne '' ) {
	    $sname = 'All';
	} elsif( defined $ReportTo{addr} ) {
	    my $son = $ReportTo{addr};
	    $sname = $sysopname{$son};
	} else {
	    $sname = 'SysOp';
	}
	
	$pkt = sendaspkt($sysop,$sname,$myaka,$ReportTo{addr},$pkt,
	'call binkp test results',$ReportTo{area});
	$files[0] = sprintf( "%08x\.pkt %d %d %d",time(),length($pkt),time(),0 );
	readndl( findndl( $ndlfile ) );
	callnode( $ReportTo{addr} );
    }

exit;