#!/usr/bin/perl
#
# Generates pointsegment.
# written by Stas Mishchenkov 2:460/58
#
#@CHRS: CP866

use strict;
use warnings;

use Getopt::Long;
use LWP::Simple;
use Cwd 'abs_path';
use Archive::Zip qw( :ERROR_CODES  :CONSTANTS );
use Time::HiRes;
use File::Spec::Functions;
use File::Copy;
use Time::Local;
use Digest::CRC qw( crc16 );
use File::Path qw(make_path remove_tree);
use Time::TZOffset qw/tzoffset/;


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

my ( %config, %nodelist, $needhelp, $prinver, $whatsnew, $errorsonly, $export,
	$check_updates, $logfile, $config, %globals, %filesfound, $notsend, $reporterrors );

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

my $tz = tzoffset( localtime() );
$tz =~ /(\d{2})(\d{2})/;
$tz = $1*3600+$2*60;

use constant PVT => 0x0001;
use constant CRA => 0x0002;
use constant RCD => 0x0004;
use constant SNT => 0x0008;
use constant ATT => 0x0010;
use constant TRS => 0x0020;
use constant K_S => 0x0080;
use constant LOC => 0x0100;
use constant HLD => 0x0200;
use constant REQ => 0x0800;
use constant RRQ => 0x1000;
use constant RRD => 0x2000;
use constant AUD => 0x4000;
use constant UPD => 0x8000;

sub usage()
{
	printf <<USAGE;

                        \"New Point Keeper.\".
   A tool for creating pointlists to Point Keepers of different levels, based
on FTS-5002 rev.2, FTS-5000 rev.5 and FTS-5001 rev.6.
                                         Written by Stas Mishchenkov 2:460/58.

Usage: $programfile options
~~~~~~
   Options:

   --help,-h               This text.

   --config,-c[=]filename  Name of config file. Required.
   --not-send,-n           Do not send pointlist. Create only.
   --report-errors,-r      Include errors log into report file.
   --export,-e             Export configuration and exit.
   --ver,-V                Print version and exit.
   --whatsnew,-w           Print whats new in new version and exit. Internet
                           connection requierd.
   --update,-u             How to update the program. Optional.
                                  =d - download. Check for a new version and
                                       download the update to a new file.
                                  =f - Force download $programfile 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. 

   --log,-l[=]filename     The name of log file. No logging if not defined.

USAGE
	exit;
}

sub readcfg($)
{

	my ($cfgfile) = @_;
	my ($line, $keyword, $rest);
	
	writelog("Reading config file $cfgfile.");
	if ( open( my $CFG, '<', $cfgfile ) ) {
		while ( $line = <$CFG> ) {
			$line =~ s/	/ /gs;
			$line =~ s/\r?\n$//s;
			$line =~ s/[ ]+$//s;
			next if $line =~ /^[ ]*\#.*/i;
			if ( $line =~ /^[ ]*([a-z_]+)[ ]+([^ ]+.*)/i ) {
				( $keyword, $rest ) = ( lc( $1 ), $2 );
				$config{$keyword} = $rest;
			}
		}
		close( $CFG );

	} else {
		print STDERR "Can't open $config{segfilename} ($!).\n";
	}
	checkconf();
}


sub mktree( $ )
{
	my ( $msgbasefile ) = @_;
	my ( $err );
		make_path( $msgbasefile, { mode => 0777, error => \$err } ) unless -d $msgbasefile;
		if ( $err && @$err ) {
			for my $diag ( @$err ){
				my ($file, $message) = %$diag;
				if ($file eq '') {
					writelog( "General error: $message");
				} else {
            		writelog( "Problem making $file: $message");
        		}
    		}
			return 0 ;
		}
	return 1;
}

sub checkconf()
{
		$logfile = $config{logfilename} if defined $config{logfilename};
		if ( defined( $config{zone} ) ) {
			if ( $config{zone} =~ /(\d+)/ ){
				$config{zone} = $1;
			} else {
				print STDERR "Zone MUST be a number of zone!\n";
				exit;
			}
		}
		if ( defined( $config{region} ) ) {
			if ( $config{region} =~ /(\d+)/ ){
				$config{region} = $1;
			} else {
				print STDERR "Region MUST be a number of region!\n";
				exit;
			}
		}
		if ( defined( $config{net} ) ) {
			if ( $config{net} =~ /(\d+)/ ){
				$config{net} = $1;
			} else {
				print STDERR "Net MUST be a number of net!\n";
				exit;
			}
		}
		unless( defined( $config{segfilename} ) ) {
			print STDERR "Segfilename must be defined!\n";
			exit;
		}
		$config{segfilename} =~ s/\./\\\./;
		$config{segfilename} =~ s/\*/\.\*/g;
		$config{segfilename} =~ s/\?/\./g;
		$globals{segmentname} = "the whole world";
		$globals{segmentname} = "Zone $config{zone}" if defined $config{zone};
		$globals{segmentname} = "Region $config{region}" if defined $config{region};
		$globals{segmentname} = "Net $config{net}" if defined $config{net};
		if ( defined( $config{workdir} ) ) {
			mktree( $config{workdir} ) unless -d $config{workdir};
			$config{uue} = catdir( $config{workdir}, 'uue');
			mktree( $config{uue} ) unless -d $config{uue};
			$config{unzipto} = catdir( $config{workdir}, 'unzip');
			mktree( $config{unzipto} ) unless -d $config{unzipto};
		} else {
			print STDERR "Workdir must be defined!\n";
			exit;
		}
		if ( defined( $config{backupdir} ) ) {
			mktree( $config{backupdir} ) unless -d $config{backupdir};
		} else {
			print STDERR "Backupdir must be defined!\n";
			exit;
		}
		if ( defined $config{sendwarnings} ) {
			$config{sendwarnings} = lc( $config{sendwarnings} );
			$config{sendwarnings} = 'no' unless $config{sendwarnings} eq 'yes';
		} else {
			$config{sendwarnings} = 'no';
		}
		$config{scannetmail} = 'no' unless defined $config{scannetmail};
		if ( defined( $config{netmail} ) ) {
			$config{scannetmail} = lc( $config{scannetmail} );
			mktree( $config{netmail} ) unless -d $config{netmail};
		} else {
			$config{sendwarnings} = 'no';
			$config{scannetmail} = 'no';
		}
		$config{chrs} = 'CP866' unless defined $config{chrs};
		$config{sysopname} = 'Point Keeper' unless defined $config{sysopname};
		$config{sendpointlistby} = lc($config{sendpointlistby}) if defined( $config{sendpointlistby} );
		if ( defined( $config{delzip} ) ) {
			$config{delzip} = lc( $config{delzip} );
			if ( $config{delzip} ne 'yes' && $config{delzip} ne 'no' ) {
				$config{delzip} = 'yes';
			}
		} else {
			$config{delzip} = 'yes';
		}
		$config{pointlistformat} = 'boss' unless defined $config{pointlistformat};
		$config{pointlistformat} = lc( $config{pointlistformat} );
		if ( defined( $config{createzipped} ) ) {
			$config{createzipped} = lc( $config{createzipped} );
			if ( $config{createzipped} ne 'yes' && $config{createzipped} ne 'no' ) {
				$config{createzipped} = 'no';
			}
		} else {
			$config{createzipped} = 'no';
		}
		if ( defined( $config{uselastread} ) ) {
			$config{uselastread} = lc( $config{uselastread} );
			if ( $config{uselastread} ne 'yes' && $config{uselastread} ne 'no' ) {
				$config{uselastread} = 'no';
			}
		} else {
			$config{uselastread} = 'yes';
		}
		if ( defined( $config{fidousernumber} ) ) {
			$config{fidousernumber} = 127 unless $config{fidousernumber} =~ /^\d+$/;
		} else {
			$config{fidousernumber} = 127;
		}
		$config{fidousernumber}++;

		if ( defined( $config{delreadmsg} ) ) {
			$config{delreadmsg} = lc( $config{delreadmsg} );
			if ( $config{delreadmsg} ne 'yes' && $config{delreadmsg} ne 'no' ) {
				$config{delreadmsg} = 'no';
			}
		} else {
			$config{delreadmsg} = 'no';
		}
		if ( defined( $config{nextfriday} ) ) {
			$config{nextfriday} = lc( $config{nextfriday} );
			if ( $config{nextfriday} ne 'yes' && $config{nextfriday} ne 'no' ) {
				$config{nextfriday} = 'no';
			}
		} else {
			$config{nextfriday} = 'no';
		}
		if ( defined( $config{reporterrors} ) ) {
			$config{reporterrors} = lc( $config{reporterrors} );
			if ( $config{reporterrors} ne 'yes' && $config{reporterrors} ne 'no' ) {
				$config{reporterrors} = 'no';
			}
		} else {
			$config{reporterrors} = 'no';
		}
		if ( $reporterrors ) {
			$config{reporterrors} = 'yes';
		}

		if ( defined( $config{checksysopname} ) ) {
			$config{checksysopname} = lc($config{checksysopname});
			$config{checksysopname} = 'yes' if $config{checksysopname} ne 'no';
		} else {
			$config{checksysopname} = 'yes';
		}
		if ( defined( $config{checkaddress} ) ) {
			$config{checkaddress} = lc($config{checkaddress});
			$config{checkaddress} = 'yes' if $config{checkaddress} ne 'no';
		} else {
			$config{checkaddress} = 'yes';
		}
		if ( defined( $config{logerrors} ) ) {
			$config{logerrors} = lc($config{logerrors});
			$config{logerrors} = 'yes' if $config{logerrors} ne 'no';
		} else {
			$config{logerrors} = 'yes';
		}
}

sub writelog
{
    my ( $str ) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
	$globals{backdir} = sprintf("%04d-%02d-%02d",
			       ($year+1900), $mon+1, $mday );
    return unless defined( $logfile );
    $str =~ s/([\r\n])$//;
	my $startstr = sprintf("%04d-%02d-%02d %02d:%02d:%02d ",
			       ($year+1900), $mon+1, $mday, $hour, $min, $sec );
    $str =~ s/([\r\n]+)/$1$startstr/g;
	
        if ( open( my $FLOG, '>>', $logfile ) ) {
			print( $FLOG "${startstr}$str\n" );
			close( $FLOG );
        } else {
            print( STDERR "Can't open $logfile. ($!)\n" );
        }
}


sub writefile($$)
{
	my ( $filename, $buff ) = @_;
	my ( $HANDLE );

	my $tmp_fn = $filename . time();

	if ( open ( $HANDLE, '>', $tmp_fn ) ) {
#	    binmode($HANDLE);
	    print( $HANDLE $buff );
	    close( $HANDLE );
	    print STDERR "Can't create $filename ($!)." unless move( $tmp_fn, $filename );
	} else {
	    print STDERR "Can't open $tmp_fn ($!).\n";
	    writelog( "Can't open $tmp_fn ($!)." );
	}
}

sub readlastread
{
	my ( $LRF, $lr );
    my $lrfile = catfile( $config{netmail}, "lastread" );
    my $lrsize = -s $lrfile;
    my $usercount = $lrsize/2 if defined $lrsize;
    if ( open( $LRF, '<', $lrfile ) ) {
        binmode( $LRF );
        read( $LRF, $lr, $lrsize );
        close( $LRF );
        return ( $usercount, unpack( "S$usercount", $lr) );
    } else {
        print( STDERR "Can't open $lrfile ($!).\n" );
        writelog( "Can't open $lrfile ($!).");
        return ( 1, 0 );
    }
}

sub writelastread
{
    my ( $users, @lastreads ) = @_;
	my ( $lastreadPath, $FLTD, $i );

    $lastreadPath = catfile( $config{netmail}, "lastread" );
	for ( $i=0; $i < $users; $i++ ){
		$lastreads[$i] = 0 unless defined $lastreads[$i];
	}

    if( open( $FLTD, '>', $lastreadPath ) ) {
        binmode( $FLTD );
        print( $FLTD pack( "S$users", @lastreads ) );
        close( $FLTD );
    }
    else
    {
        print(STDERR "Can't open \"$lastreadPath\".($!)\n");
        writelog("Can't open \"$lastreadPath\".($!)");
    }
}

sub writemsg
{
    my ( $msgpath, $fromUserName,$toUserName,$subject,$DateTime,
    $timesread,$destnode,$orignode,$cost,$orignet,$destnet,
    $date_written16,$time_written16,$date_arrived,$time_arrived,$replyto,
    $attr,$nextmsg ) = @_;
    
    if( open( my $FL, '>', $msgpath ) ) {
        binmode( $FL );
        print( $FL pack( "Z36Z36Z72Z20S13Z".(length($globals{msgtext})),
        $fromUserName,$toUserName,$subject,$DateTime,
        $timesread,$destnode,$orignode,$cost,$orignet,$destnet,
        $date_written16,$time_written16,$date_arrived,$time_arrived,
        $replyto,$attr,$nextmsg,$globals{msgtext} ) );
        close( $FL );
	} else {
        print( STDERR "Can't open \"$msgpath\".($!)\n" );
        writelog( "Can't open \"$msgpath\".($!)" );
    }
}

sub sendmsg
{
	my ( $fromname, $toname, $fromaddress, $toaddress, $subj, $attr ) = @_;
	my ( $maxmsgnum, $dirhandle, $msgfilename, $destnode, $orignode,
		$orignet, $destnet );
	return unless defined( $config{netmail} );
	return unless defined( $fromaddress );
	
	unless( opendir( $dirhandle, $config{netmail} ) ) {
		writelog( "Can't open $config{netmail} ($!)." );
		return;
	}
	$maxmsgnum = 0;
	while ( readdir( $dirhandle ) ) {
		if ( $_ =~ /(\d+)\.msg$/i ) {
			$maxmsgnum = $1 if $1 > $maxmsgnum;
		}
	}
	closedir( $dirhandle );
	$maxmsgnum++;
	$msgfilename = catfile( $config{netmail}, "$maxmsgnum\.msg" );

    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";

    $toaddress =~ /^(\d+)\:(\d+)\/(\d+)$/;
	( $destnet, $destnode ) = ( $2, $3 );

    $fromaddress =~ /^(\d+)\:(\d+)\/(\d+)$/;
	( $orignet, $orignode ) = ( $2, $3 );

	$globals{msgtext} =~ s/\n/\r/g;

    my $TZUTC = sprintf( "%04d", tzoffset( localtime() ) );

	$globals{msgtext} = "\001MSGID: $fromaddress " . sprintf( "%08x", time() ).
						"\r\001TZUTC: $TZUTC\r" .
						"\001INTL $toaddress $fromaddress\r" .
						"\001CHRS: ".uc($config{chrs})." 2\r" .
						$globals{msgtext} .
						"\r--- $programfile $vers\r" .
						" \* Origin: New Point Keeper ($fromaddress)\r\x00";

	writemsg( $msgfilename, $fromname, $toname, $subj, $DateTime,
			0,$destnode,$orignode,0,$orignet,$destnet, 0,0,0,0,0,
			$attr, 0 );

}

sub uu_decode($;$)
{
	my ( $mtext, $uuedir ) = @_;
	my $uudecoded_data;

	if ( !defined($uuedir) ){
		$uuedir = catdir( $config{workdir}, 'uue');
		mktree $uuedir unless -d $uuedir;
	}

	my $i = 0;
	while ( $mtext =~ /\r\n?begin \d+[ ]+([^\r\n?]+)\r\n?([^ ]*?\r\n?)end\r\n?/i ){
        my $uuf = $1;
	    my @uuelines = split(/\r\n?/,$2);
		$uuf = $1 if $uuf =~ /[\\\/]+([^\\\/]+)$/;
		writelog( "UUencoded file $uuf found." ); 
	    my $ofile = catfile( $uuedir, $uuf );
	    if ( open( my $F, '>', $ofile ) ){
			binmode( $F );
			foreach my $val ( @uuelines ){
				$uudecoded_data = unpack("u", $val);
				print( $F $uudecoded_data ) if defined $uudecoded_data;
			}
			close( $F );
			undef @uuelines;
			$i = 1;
		} else {
			writelog("Can't open \"$ofile\"\: $!\.");
			print STDERR "Can't open \"$ofile\" ($!).\n";
	    }
		$mtext =~ s/\r\n?begin \d+[ ]+[^\r\n?]+\r\n?[^ ]*?\r\n?end\r\n?/\r\n/i;
	}
return $i;
}

sub scannetmail()
{
	my ( $DN, $msgpath, $msgsize, $FM, $msgheader, $destaddress, @lr, $users );

	return unless defined( $config{netmail} );

	unless ( opendir( $DN, $config{netmail} ) ) {
		print(STDERR "Can't open $config{netmail} directory ($!).\n");
	    writelog( "Can't open $config{netmail} directory ($!)." );
        return;
    }
    printf("Reading NetMail area...\n");
    writelog("Reading NetMail area...");

	@lr = readlastread();
	if ( $lr[0] < $config{fidousernumber} ){
		$lr[0] = $config{fidousernumber};
		$lr[$config{fidousernumber}] = 0;
	}
	unless ( $config{uselastread} eq 'yes' ) {
#		$lr[0] = $config{fidousernumber};
		$lr[$config{fidousernumber}] = 0;
	}
	writelog( "Users: $lr[0], user number: " . ( $config{fidousernumber} - 1 ) . 
              ", lastread: $lr[$config{fidousernumber}]." );

    while( readdir( $DN ) ) {
		if( $_ =~ /^(\d+)\.msg/i) {
			next if $1 <= $lr[$config{fidousernumber}];
			$lr[$config{fidousernumber}] = $1;
            $msgpath = catfile( $config{netmail}, $_ );
			$msgsize = -s $msgpath;
            unless ( open( $FM, '+<', $msgpath ) ) {
				print STDERR "Can't open $msgpath ($!).\n";
				writelog( "Can't open $msgpath ($!)." );
				next;
			}
			binmode( $FM );
            unless ( read( $FM, $msgheader, 190 ) == 190 ) {
				print STDERR "Can't read $msgpath ($!).\n";
				writelog( "Can't read $msgpath ($!)." );
				close( $FM );
				next;
			}
			my ($fromUserName,$toUserName,$subject,$DateTime,
				$timesread,$destnode,$orignode,$cost,$orignet,$destnet,
				$date_written16,$time_written16,$date_arrived16,$time_arrived16,
				$replyto,$attr, $nextmsg) = unpack("Z36Z36Z72Z20S12",$msgheader);
            unless ( read( $FM, $globals{msgtext}, $msgsize - 190 ) == ( $msgsize - 190 ) ) {
				print STDERR "Can't read $msgpath ($!).\n";
				writelog( "Can't read $msgpath ($!)." );
				close( $FM );
				next;
			}

			$destaddress = "$destnet/$destnode";
			if ( defined( $config{zone} ) ) {
				$destaddress = "$config{zone}\:$destaddress";
			} else {
				if ( $config{address} =~ /^(\d+)\:/ ) {
					$destaddress = "$1\:$destaddress";
				}
			}
			if( $globals{msgtext} =~ /\x01INTL:?[ ]+(\d+:\d+\/\d+)[ ]+(\d+:\d+\/\d+)[ ]*\r\n?/ ) {
				$destaddress = $1;
			}
			if( $globals{msgtext} =~ /\x01TOPT:?[ ]+(\d+)[ ]*\r\n?/ ) {
				$destaddress .= "\.$1";
			}
# checkaddress -->
			if ( $config{checkaddress} eq 'yes' && $destaddress ne $config{address}) {
				if ( seek( $FM, 186, 0 ) ) {
					$attr |= RCD;
					print $FM pack("S2",$attr);
				}
				close( $FM );
				writelog("message from $fromUserName to $toUserName $destaddress ne $config{address}.");
				next;
			}
# checksysopname -->
			if ( $config{checksysopname} eq 'yes' && $toUserName !~ /$config{sysopname}/i ) {
				if ( seek( $FM, 186, 0 ) ) {
					$attr |= RCD;
					print $FM pack("S2",$attr);
				}
				close( $FM );
				writelog("message from $fromUserName to $toUserName $destaddress ne \'$config{sysopname}\'.");
				next;
			}

			writelog("Reading message from $fromUserName to $toUserName $destaddress.");
#			unless( $globals{msgtext} =~ /begin[ ]+\d+[ ]+$config{segfilename}/i ) {
#				if ( seek( $FM, 186, 0 ) ) {
#					$attr |= RCD;
#					print $FM pack("S2",$attr);
#				}
#				close( $FM );
#				writelog( 'UUencoded segment not found.' );
#				next;
#			}
#			writelog( "Message from $fromUserName for us found." );
			if ( seek( $FM, 186, 0 ) ) {
				$attr |= RCD;
				print $FM pack("S2",$attr);
			}
# -- uudecode -->
			close( $FM );
			if ( uu_decode( $globals{msgtext}, $config{uue} ) ) {
				readinbound( $config{uue} );
				unlink $msgpath if $config{delreadmsg} eq 'yes';
			}
		}
	}
    closedir( $DN );
	writelastread( @lr );
}

sub update()
{
    return if $check_updates eq 'n';
    return unless $check_updates =~ /^[nwdf]$/;

    my ( $ver_s, $upd, $of, $progname );
	if ( $programfile =~ /^(.*?)\..*$/ ) {
		$progname = $1;
	} else { $progname = 'npk'; }

    $ver_s = get( $url . "$progname.v");
    if (defined ($ver_s) ) {
	if ( $check_updates eq 'f' ) {
	    $of = catfile( $curpath,"${progname}_${ver_s}\.zip" );
		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' ) {
			$of = catfile( $curpath,"${progname}_${ver_s}\.zip" );
		} else {
			$of = catfile( $curpath,"${progname}_${ver_s}\.zip" );
		}
		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 . "$progname.zip" );
	unless( defined $upd ) {
	    print STDERR "Can't get update.\n";
	    writelog("Can't get update. ${url}${progname}.zip\n");
	    return;
	}
	my $OF;
	if ( open ( $OF, '>', $of ) ) {
	    binmode( $OF );
	    print( $OF $upd );
	    close( $OF );
	    chmod 0755, $of if $^O eq 'linux';
	    print "$of saved.\n\n";
	} else {
	    print STDERR "Can't open $of ($!).\n";
	}
    } else {
		print STDERR "Can't connect to $url\n";
		writelog("Can't connect to $url\n");
    }
    exit if $check_updates eq 'f';
}

sub whats_new()
{
		my $wn = get( $url . 'npk.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;
}


sub read_pnt_time($)
{
   my ( $filename ) = @_;
   my ( $FH, $line );

   if ( open( $FH, '<', $filename ) ) {
	$line = readline( $FH ); 
	close( $FH );
	if ( $line =~ /\;.*?(\d+)[ \-]*Day[ number]* (\d+)/i ) {
		return sprintf( "%d%03d", $1, $2 );
	} else {
		my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
										localtime( ( stat( $filename ) )[10] );
		return sprintf( "%d%3d", $year + 1900, $yday );
	}
   } else {
	print STDERR "Cant read $filename ($!).\n";
	writelog( "Cant read $filename ($!)." );
	return 0;
   }
}



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 '';
    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 );
}

my ( %regions, %nets );

sub readndl($)
{
    my ($nlist) = @_;
    my ($zone, $net, $node, $region, $dom, $ird, $domain, $start, $nldate );
    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::HiRes::time;
    $zone = $net = $node = 0;
    $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;
		$globals{nodelistldate} = $nldate;
	    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);
	$uflag = "";
	%flags = ();
	@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;
		$regions{$region} = '' if defined( $config{zone} ) && $zone == $config{zone};
		$nets{$net} = '--- not listed ---' if defined( $config{region} ) && $region == $config{region};
	} elsif ($keyword eq "Host") {
	    $net = $node;
	    $node = 0;
	    $domnet = '';
		$nets{$net} = '--- not listed ---' if defined( $config{region} ) && $region == $config{region};
	}
	if ( defined( $config{zone} ) ) {
		next unless $zone == $config{zone};
	}
	if ( defined( $config{region} ) ) {
		next unless $region == $config{region};
	}
	if ( defined( $config{net} ) ) {
		next unless $net == $config{net};
	}
	if ( defined( $flags ) ) {
		if ( $flags =~ /,NPK/i ) {
			$nets{$net} = "$name $zone\:$net\/$node";
			$nets{$net} =~ s/_/ /g;
		} elsif ( $flags =~ /,RPK/i ) {
			$regions{$region} = "$name $zone\:$net\/$node";
			$regions{$region} =~ s/_/ /;
			$nets{$region} = "$name $zone\:$net\/$node";
			$nets{$region} =~ s/_/ /;
		}
	}

		$nodes++;
		$name =~ s/_/ /g;
		$nodelist{"$zone\:$net\/$node"} = $name;
   }
    close($F);
    my $lstr = "Nodelist $nldate parsed, $nodes nodes processed (" . sprintf( "%.3f" ,(Time::HiRes::time() - $start) ) . " sec)";
    print( "$lstr\n" );
    writelog( $lstr );
}

sub readfile($)
{
	my ( $filename ) = @_;
	my ( $HANDLE, $size, $buff );

	$size = -s $filename;
	if ( open ( $HANDLE, '<', $filename ) ) {
	    unless( read( $HANDLE, $buff, $size ) > 0 ) {
	    	print STDERR "Can't read $filename ($!).\n";
	    	writelog( "Can't read $filename ($!)." );
			close( $HANDLE );
			return 0;
		}
	    close( $HANDLE );
	} else {
	    print STDERR "Can't open $filename ($!).\n";
	    writelog( "Can't open $filename ($!)." );
	}
	return $buff;
}


my ( %bossnodes );
my %modemflags = ( V22 => '', V29 => '', V32 => 'V22', V32B => 'V32,V22',
                   V32T => 'V32B,V32,V22', V34 => 'V22,V32,V32B', V42 => 'MNP',
                   V42B => 'V42,MNP', MNP => '', H96 => '', HST => 'MNP',
                   H14 => 'HST,MNP', H16 => 'H14,HST,MNP,V42,V42B', MAX => '',
                   PEP => '', CSP => '', VFC => 'V32B,V32,V22',
                   ZYX => 'V22,V32B,V32,V42B,V42,MNP',
                   V90C => 'V34,V22,V32,V32B', V90S => 'V34,V22,V32,V32B',
                   X2C => 'V22,V32,V32B,V34', X2S => 'V22,V32,V32B,V34',
                   Z19 => 'ZYX,V32B,V32,V42B,V42,MNP,V22'
                 );

sub knownflag( $ )
{
	my ( $flag ) = @_;
	my %knownflags = ( 'CM' => '', 'ICM' => '', 'MO' => '', 'LO' => '',
						'MN' => '', 'IBN' => '', 'IFC' => '', 'IFT' => '',
						'ITN' => '', 'IVM' => '', 'GUUCP' => '', 'XA' => '',
						'XB' => '', 'XC' => '', 'XP' => '', 'XR' => '',
						'XW' => '', 'XX' => '', 'INO4' => '', 'ITX' => '',
						'IUC' => '', 'IMI' => '', 'ISE' => '', 'EVY' => '',
						'EMA' => '', 'IEM' => '', 'U' => '', 'V110L' => '',
						'V110H' => '', 'V120L' => '', 'V120H' => '',
						'X75' => '', 'ISDN' => '', 'PING' => '', 'TRACE' => '',
						'ZEC' => '', 'REC' => '', 'NEC' => '', 'NC' => '',
						'SDS' => '', 'SMH' => '', 'RPK' => '', 'NPK' => '',
						'ENC' => '', 'CDP' => '', 'INA' => '', 'BEER' => ''
					 );
	my ( $f );

	return 1 if defined $modemflags{$flag};
	return 1 if $flag =~ /^T[a-x][a-x]$/i;

	if ( $flag =~ /([\#\!])\d\d/ ) {
		foreach $f ( split( /$1/, $flag ) ) {
			if ( $f eq '02' || $f eq '08' || $f eq '09' || $f eq '17' ) {
				return 1;
			} else {
				return 0 if defined$f && $f ne '';
			}
		}
		return 1;
	}
	if ( $flag =~ /^(I[BFTVN][NCTMA])\:.*/i ) {
		$flag =~ s/^(I[BFTVN][NCTMA])\:.*/$1/i;
	}
	if ( $flag =~ /[IE][TUMSVE][XCIEYAM]\:.*/ ) {
		$flag =~ s/([IE][TUMSVE][XCIEYAM])\:.*/$1/;
	}
	if ( $flag =~ /BEER\:.*/ ) {
		$flag =~ s/(BEER)\:.*/$1/;
	}
	return 1 if defined $knownflags{$flag};
	return 0;
}

sub readseg( $ )
{
	my ( $filename ) = @_;
	my ( $FH, $line, $boss, $point, $system, $location, $sysop, $phone, $baud,
		$flags, $errstr, $fl, $keyword, $fseg, $newboss );
	my @ipflags = ( 'IBN', 'IFC', 'IFT', 'ITN', 'IVM' );
	my @nomeaningflags = ( 'CM', 'ICM', 'MO', 'LO', 'MN' );
	my %baudrate = ( '300' => 1, '1200' => 1, '2400' => 1, '4800' => 1,
					'9600' => 1, '14400' => 1, '16800' => 1, '19200' => 1,
					'28800' => 1, '33600' =>1, '38400' => 1 );

	if ( open( $FH, $filename ) ) {
		if ( $filename =~ /([^\\\/]*?)\.[ndl\d]{3}$/ ) {
			$fseg = $1;
			$globals{report} .= "*** filename: $fseg ***\n" if $config{reporterrors} eq 'yes';
		}
		$errstr = '';
		my $ln = 0;
		while( $line = <$FH> ) {
			if( $line =~ /\;A (.*?Day[ number]*\d+).*/i ) {
				writelog( "Found $fseg $1." ) if $ln == 0;
			}
			$ln++;
			next if $line =~ /^\s*\;/;
			$line =~ s/[\r\n\x1A]//g;
			next if $line eq '';
			if ( $line =~ /^Boss\,(\d+\:\d+\/\d+)\,?.*$/i ) {
				$newboss = $1;
				if ( defined( $boss ) && defined( $nodelist{$boss} ) ) {
					if ( $bossnodes{$boss}{errors} ne '' ) {
						writelog( $bossnodes{$boss}{errors} ) if $config{logerrors} eq 'yes';
						$globals{report} .= "$bossnodes{$boss}{errors}\n" if $config{reporterrors} eq 'yes';
						$globals{msgtext} = $bossnodes{$boss}{errors};

						sendmsg( $config{sysopname}, $nodelist{$boss},
								$config{address}, $boss,
								'Errors in your point segment.',
								PVT+K_S+LOC ) if $config{sendwarnings} eq 'yes';

						$bossnodes{$boss}{errors} = '';
					} else {
						writelog( " No errors found." ) if $config{logerrors} eq 'yes';
						$globals{report} .= "No errors found.\n"  if $config{reporterrors} eq 'yes';
					}
				}
				$boss = $newboss;
				$bossnodes{$boss}{errors} = '';
				$bossnodes{$boss}{points} = '';
				writelog( "Boss $boss" );
#				writelog( "~~~~ WARNING! Unknown node!" ) unless defined( $nodelist{$boss} );
				$globals{report} .= "=== Boss node: $boss ===\n" if defined( $nodelist{$boss} )  && $config{reporterrors} eq 'yes';
				unless ( defined( $nodelist{$boss} ) ) {
					writelog( "~~~~ WARNING! Unknown node! Skipping!" );
					next;
				}
			} elsif ( $line =~ /^(.*?)\,(\d+)\,(.*?)\,(.*?)\,(.*?)\,(.*?)\,(\d+)(.*)$/i ) {
				( $keyword, $point, $system, $location, $sysop, $phone, $baud,
				 $flags ) = ( $1, $2, $3, $4, $5, $6, $7, $8 );

				unless ( defined( $boss ) ) {
					writelog( "     WARNING! Bo Boss defined. Skipping unknown node points!" );
					next;
				}

				unless ( defined( $nodelist{$boss} ) ) {
					writelog( "     WARNING! Skipping unknown node points!" );
					next;
				}

				if ( $keyword eq 'Point' && $config{pointlistformat} eq 'boss' ) {
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "The \"Poss\" (pointplus) format is deprecated.\r";
				} elsif ( $keyword ne '' && $keyword ne 'Point' ) {
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Meaningless keyword \'$keyword\' must not be used.\r";
				}
				if ( $point > 32767 ) {
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Error: Point number must be in the range of 1 to 32767. The line is dropped!.\r";
					undef $point;
				}
				if ( $sysop =~ /\s/ ) {
					$sysop =~ s/\s/_/g;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "ERROR: Sysop name must not contain spaces.\r";
				}
				if ( $sysop !~ /(UUCP)|(_)/i ) {
					$sysop = "Named_as_$sysop";
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Starting \#037/09 one word sysop names are no longer permitted except the keyword \'UUCP\'.\r";
				}
				if ( length($sysop) > 36 ) {
					$sysop = substr($sysop, 0, 36);
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "SysOp name can not be longer then 36 letters include space. The result is: \"$sysop\"\r";
				}
				if ( $sysop =~ /[^\x21-\x7E]/ ) {
					$sysop =~ s/([^\x21-\x7E])/\#/g;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Not permitted letters in SysOp name replaced by \'\#\'. The result is: \"$sysop\"\r";
				}
				if ( $location =~ /[^\x21-\x7E]/ ) {
					$location =~ s/([^\x21-\x7E])/\#/g;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Not permitted letters in location name replaced by '#'. The result is: \"$location\"\r";
				}
				if ( $system =~ /[^\x21-\x7E]/ ) {
					$system =~ s/([^\x21-\x7E])/\#/g;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Not permitted letters in System name replaced by '#'. The result is: \"$system\"\r";
				}
# --- flags --->
				if ( $phone =~ /\-Unpublished\-/i ) {
					if ( $baud ne '300' ) {
						$baud = '300';
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Baud must be 300 if phone is -Unpublished-.\r";
					}
					foreach  $fl ( keys %modemflags ) {
						if ( $flags =~ /\,($fl)\b/i ) {
							$flags =~ s/\,($fl)\b//i;
							if ( $line ne $errstr ) {
								$bossnodes{$boss}{errors} .= "$line\r";
								$errstr = $line;
							}
							$bossnodes{$boss}{errors} .= "Flag \'$1\' has no meaning  if phone is -Unpublished-.\r";
						}
					}
					if ( $flags !~ /\,INA/i && 
						$flags !~ /\,I[BFTV][NCTM]\:.*/i) {
						if ( $flags =~ /\,(X[ABCPRWX])/i ) {
							$flags =~ s/\,(X[ABCPRWX])//i;
							if ( $line ne $errstr ) {
								$bossnodes{$boss}{errors} .= "$line\r";
								$errstr = $line;
							}
							$bossnodes{$boss}{errors} .= "Flag \'$1\' has no meaning if no connection info.\r";
						}
						foreach $fl ( @nomeaningflags ){
							if ( $flags =~ /\,($fl)/i ) {
								$flags =~ s/\,($fl)//i;
								if ( $line ne $errstr ) {
									$bossnodes{$boss}{errors} .= "$line\r";
									$errstr = $line;
								}
								$bossnodes{$boss}{errors} .= "Flag \'$1\' has no meaning if no connection info.\r";
							}
						}
						if ( $flags =~ /\,(T[a-x][a-x])\b/i ) {
							$flags =~ s/\,(T[a-x][a-x])\b//ig;
							if ( $line ne $errstr ) {
								$bossnodes{$boss}{errors} .= "$line\r";
								$errstr = $line;
							}
							$bossnodes{$boss}{errors} .= "Flag \'$1\' has no meaning if no connection info.\r";
						}
					} else {
						if ( $flags =~ /\,ICM/i ) {
							$flags =~ s/\,ICM/\,CM/i;
							if ( $line ne $errstr ) {
								$bossnodes{$boss}{errors} .= "$line\r";
								$errstr = $line;
							}
							$bossnodes{$boss}{errors} .= "Flag \'ICM\' not for ip only systems. It must be \'CM\' flag instead.\r";
						}
					}
				} else {
					foreach my $key ( keys %modemflags ) {
						if ( $flags =~ /\,$key\b/i && $modemflags{$key} ne '' ) {
							foreach my $impl ( split( /,/, $modemflags{$key} ) ) {
								if ( $flags =~ /\,$impl\b/i  ) {
									$flags =~ s/\,($impl)\b//i;
									if ( $line ne $errstr ) {
										$bossnodes{$boss}{errors} .= "$line\r";
										$errstr = $line;
									}
									$bossnodes{$boss}{errors} .= "Flag $key implies \'$1\'.\r";
								}
							}
						}
					}
					unless ( defined( $baudrate{$baud} ) ) {
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Illegal baud rate \'$baud\'.\r";
						foreach my $br ( sort { $b <=> $a } keys %baudrate ) {
							if ( $baud > $br ) {
								$baud = $br;
								last;
							}
						}
						if ( $baud < 300 ) {
							$baud = 300;
						}
					}
					if ( $phone !~ /[\d\-]{3,29}/ ) {
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Error: The phone number must be from 3 up to 29 digits and dashes, or the exact string \"-Unpublished-\".\rThe line is dropped!\r";
						undef $point;
					}
				}
				if ( $flags =~ /\,(T[a-x][a-x])\b/i && $flags =~ /\,CM\b/i ) {
					$flags =~ s/\,(T[a-x][a-x])\b//ig;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
					$bossnodes{$boss}{errors} .= "Flag CM implies \'$1\'.\r";
				}
				if ( $flags =~ /\,([\!\#]\d\d)\b/ && $flags =~ /\,CM\b/i ) {
					$flags =~ s/\,([\!\#]\d\d)\b//g;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
					$bossnodes{$boss}{errors} .= "Flag CM implies \'$1\'.\r";
				}
				if ( $flags =~ /\,(ICM)\b/ && $flags =~ /\,CM\b/i ) {
					$flags =~ s/\,(ICM)\b//g;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
					$bossnodes{$boss}{errors} .= "Flag CM implies \'$1\'.\r";
				}
				foreach my $ipfl ( @ipflags ) {
					if ( $flags =~ /\,$ipfl\:?\d*/i && 
						$flags !~ /\,$ipfl\:[^\.]+[\.]+[^\.]+/i) {

						$flags =~ s/\,($ipfl\:?\d*)//i;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Flag \'$1\' has no meaning if no INA flag.\r";
				    }
				}
				if ( $flags =~ /\,TCP\b/ ) {
					$flags =~ s/\,TCP\b/\,TCo/;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Starting #169/21 the irregular use of a TCP flag Starting #169/21 the use of a TCP flag is prohibited.\r";
				}
				if ( $flags =~ /(.*?)\,U(\,.*)$/ ) {
					my ( $regflags, $uflags ) = ( $1, $2 );
					while ( $uflags =~ /(\,T[a-x][a-x])\b/i ){
						$regflags .= $1;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Starting \#251/12 the System open hours flag Txy moves from userflag to a regular flag.\r";
						$uflags =~ s/$1//;
					}
					$flags = "$regflags\,U$uflags";
				}
				if ( $flags =~  /\,IP\b/ ) {
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "IP flag denotes an unspecified protocol. Deprecated.\r";
					$flags =~  s/\,IP\b//;
				}
				foreach my $flg ( split( /,/, $flags ) ) {
					next if $flg eq '';
					unless ( knownflag( $flg ) ) {
						$flags =~ s/\,$flg//;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Unknown flag \'$flg\'. Removed.\r";
					}
				}
				if ( $flags =~ /\,V90C/ && $flags =~ /\,V90S/ ) {
						$flags =~ s/\,V90C//;
						$flags =~ s/\,V90S//;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Error: the V90C and V90S flags are mutually exclusive. Removed.\r";
				}
				if ( $flags =~ /\,X2C/ && $flags =~ /\,X2S/ ) {
						$flags =~ s/\,X2C//;
						$flags =~ s/\,X2S//;
						if ( $line ne $errstr ) {
							$bossnodes{$boss}{errors} .= "$line\r";
							$errstr = $line;
						}
						$bossnodes{$boss}{errors} .= "Error: the X2C and X2S flags are mutually exclusive. Removed.\r";
				}
				if ( $flags =~ /\,HST/ || $flags =~ /\,H14/ ||
						$flags =~ /\,H16/ || $flags =~ /\,X2S/ ||
						$flags =~ /\,X2C/ ) {
						if ( $flags =~ /\,ZYX/ || $flags =~ /\,Z19/ ) {
							$flags =~ s/\,Z[Y1][X9]//;
							$flags =~ s/\,H[S1][T46]//;
							$flags =~ s/\,X2[CS]//;
							if ( $line ne $errstr ) {
								$bossnodes{$boss}{errors} .= "$line\r";
								$errstr = $line;
							}
							$bossnodes{$boss}{errors} .= "Error: no modem has at the same time the US Robotics proprietary protocols and the ZyXEL ones. Removed.\r";
						}
				}
				if ( $flags =~ /\,X[ABCPRWX].*?\,X[ABCPRWX]/i ) {
					$flags =~ s/\,X[ABCPRWX]//gi;
					if ( $line ne $errstr ) {
						$bossnodes{$boss}{errors} .= "$line\r";
						$errstr = $line;
					}
					$bossnodes{$boss}{errors} .= "Error: File/Update Request Flags are mutually exclusive. Removed.\r";
				}
				$flags =~ s/\,$// if $flags  =~ /\,$/;
				$flags =~ s/\,U$// if $flags  =~ /\,U$/;
# --- flags --->
			} else {
				next if $line eq '';
				if( $line =~ /Boss/i ) {
					writelog("ERROR! Invalid Boss line: \'$line\'. Skipping.");
					undef $boss;
				} elsif( $line =~ /\d+\:\d+\/\d+/ ) {
					writelog("ERROR! Invalid Boss line: \'$line\'. Skipping.");
					undef $boss;
				}
				if ( defined( $boss ) ) {
					$bossnodes{$boss}{errors} .= "Invalid line: \'$line\'.\r";
					writelog("ERROR! Invalid line: \'$line\'.\rStop processing file.");
					print STDERR "Invalid line: \'$line\'.\r";
					return;
				}
				next;
			}
			if ( defined( $boss ) && defined( $point ) ) {
				if ( $config{pointlistformat} eq 'pointplus' ) {
					$bossnodes{$boss}{points} .= "Point,$point,$system,".
												"$location,$sysop,".
								                "$phone,$baud$flags\n";
				} else {
 					$bossnodes{$boss}{points} .= ",$point,$system,$location," .
												"$sysop,$phone,$baud$flags\n";
				}
				undef $point;
			}
		}
		close( $FH );
		if ( defined( $boss ) && defined( $nodelist{$boss} ) ) {
			if ( $bossnodes{$boss}{errors} ne '' ) {
				writelog( $bossnodes{$boss}{errors} ) if $config{logerrors} eq 'yes';
				$globals{report} .= "$bossnodes{$boss}{errors}\n"  if $config{reporterrors} eq 'yes';
				$globals{msgtext} = $bossnodes{$boss}{errors};
				sendmsg( $config{sysopname}, $nodelist{$boss},
						$config{address}, $boss,
						'Errors in your point segment.',
						PVT+K_S+LOC ) if $config{sendwarnings} eq 'yes';
				$bossnodes{$boss}{errors} = '';
			} else {
				writelog( " No errors found." ) if $config{logerrors} eq 'yes';
				$globals{report} .= "No errors found.\n"  if $config{reporterrors} eq 'yes';
			}
		}
		writelog( " --- Done. $ln lines read." );
	} else {
		writelog( "Can't open $filename ($!)." );
		print STDERR "Can't open $filename ($!).\n";
	}
	
}

sub uu_encode($;$)
{

    my ( $filename, $mode ) = @_;
    my ( $uuestr, $bindata, $FUU );

    $mode ||= "644";
    if ( $filename =~ /.*[\\\/]([^\\\/]+)$/ ) {
       $uuestr = "\rbegin $mode $1\r";
    } else {
        writelog("Full path MUST be specified. $filename has no path.");
		print STDERR "Full path MUST be specified. $filename has no path.\n";
        return '';
    }
    if ( open( $FUU, $filename ) ) {
        binmode( $FUU, ':raw' );
        while ( read( $FUU, $bindata, 45 ) ) {
            $uuestr .= pack("u", $bindata);
        }
        close($FUU);
        $uuestr .= "end\r\r";
        return($uuestr);
    }
    else {
        writelog("Can't open \"$filename\"\: $!");
		print STDERR "Can't open \"$filename\"\: $!\n";
        return('');
    }
}

sub sendpointlist( $ )
{
	my ( $filename ) = @_;
	my ( $toname, $toaddress, $boxname );
	
	writelog( "Sending $filename by $config{sendpointlistby}." );
	unless( defined( $config{sendpointlistto} ) ) {
		writelog( "SendPointlistTo not defined." );
		return;
	}
	if ( $config{sendpointlistto} =~ /(.*?)\s+(\d+\:\d+\/\d+)/ ) {
		( $toname, $toaddress ) = ( $1, $2 );
		if ( $config{sendpointlistby} eq 'netmail' ) {
			unless ( defined( $config{address} ) ) {
				writelog( "ERROR: your address must be defined." );
				return;
			}
			unless ( defined( $config{netmail} ) ) {
				writelog( "ERROR: netmail area must be defined." );
				return;
			}
			$globals{msgtext} = "\r   Pointlist of $globals{segmentname}\r";
			sendmsg( $config{sysopname}, $toname,$config{address}, $toaddress,
						$filename, PVT+K_S+LOC+ATT );
		} elsif ( $config{sendpointlistby} eq 'uue' ) {
			unless ( defined( $config{address} ) ) {
				writelog( "ERROR: your address must be defined." );
				return;
			}
			unless ( defined( $config{netmail} ) ) {
				writelog( "ERROR: netmail area must be defined." );
				return;
			}
			$globals{msgtext} = uu_encode( $filename );
			unless( $globals{msgtext} eq '' ) {
				sendmsg( $config{sysopname}, $toname,$config{address}, 
						$toaddress, "pointlist $globals{segmentname}", 
						PVT+K_S+LOC );
			}
		} elsif ( $config{sendpointlistby} eq 'brakebox' ) {
			unless( defined( $config{brakeboxes} ) ) {
				writelog( "BrakeBoxes must be defined." );
				return;
			}
			$boxname = $toaddress;
			$boxname =~ s/[\:\/]/\./g;
			$boxname = catdir( $config{brakeboxes}, "fidonet.$boxname.0.direct" );
			mktree( $boxname ) unless -e $boxname;
			copy( $filename, $boxname );
		}
		writelog( "Sending done." );
	} else {
		writelog( "ERROR: SendPointlistTo must be the Name and the 3D fidonet address." );
		return;
	}
}

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);
    }
    if ($b =~ /(\d+):(\d+)\/(\d+)(?:\.(\d+))?$/)
    {
        ($bz, $bn, $bf, $bp) = ($1, $2, $3, $4);
    }
    return ($az<=>$bz) || ( $an cmp $bn ) || ($af<=>$bf) || ($ap<=>$bp);
}

sub pointsort
{
	my ( $ap, $bp );
	if ( $a =~ /^.*?,(\d+),.*/i) {
		$ap = $1;
	}
	if ( $b =~ /^.*?,(\d+),.*/i) {
		$bp = $1;
	}
	return ( $ap <=> $bp );
}

sub createpntlist()
{
	my ( $FH, $pntlsttext, $crc, $zfname, $daynumber, $headertxt );
	my @abbr = qw(January February March April May June July August September October November December);
	my @wdaray = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
	$year = $year + 1900;
	$yday++;
	if ( $config{nextfriday} eq 'yes' ) {
		$daynumber = sprintf( "%03d", $yday + 5 - $wday );
		$daynumber = sprintf( "%03d", $yday + $wday ) if $wday > 5;
	} else {
		$daynumber = sprintf("%03d", $yday );
	}


	writelog( "Building pointlist $globals{segmentname} for $wdaray[$wday], $abbr[$mon] $mday, $year -- Day number $daynumber." );
	if ( defined $config{header} ) {
		$headertxt = readfile( $config{header} );
	} else { $headertxt =  '' }

	if ( open( $FH, '>', "$config{pointlist}.$daynumber"  ) ) {
		$pntlsttext = ";S Created by New Point Keeper $vers.\n".
					  ";S Checked against nodelist $globals{nodelistldate}\n";
		$pntlsttext .= $headertxt;
		$pntlsttext .= "\n" unless $pntlsttext =~ /\n$/;
		$pntlsttext .= "$globals{fileslist};S ============================================================================\n\;\n";
		$globals{report} = "$globals{fileslist}\n$headertxt\n$globals{report}";
		foreach my $boss ( sort nodesort keys %bossnodes ) {
			next unless defined $nodelist{$boss};
			next if $bossnodes{$boss}{points} eq '';
			$pntlsttext .= "\;\nBoss,$boss\n";
			foreach my $pnt ( sort pointsort split( /\n/, $bossnodes{$boss}{points} ) ) {
				$pntlsttext .= "$pnt\n";
			}
		}
		$crc = sprintf( "%05d", crc16( $pntlsttext ) );
		$pntlsttext = ";A Pointlist of $globals{segmentname} for $wdaray[$wday], $abbr[$mon] $mday, $year -- Day number $daynumber : $crc\n$pntlsttext";
		$globals{report} = "Pointlist of $globals{segmentname} for $wdaray[$wday], $abbr[$mon] $mday, $year -- Day number $daynumber\n" .
						   "Created by New Point Keeper $vers.\n".
						   "Checked against nodelist $globals{nodelistldate}\n".
						   $globals{report};
		print $FH $pntlsttext;
		close( $FH )
	} else {
		print STDERR "Can't open $config{pointlist}.$daynumber ($!).\n";
		writelog( "Can't open $config{pointlist}.$daynumber ($!)." );
	}
	writelog( "Building pointlist $config{pointlist}\.$daynumber done." );
	if ( $config{createzipped} =~ /^yes$/i ) {
		if ( $config{pointlist} =~ /([^\\\/]+)$/ ) {
			$zfname = "$1\.$daynumber";
			my $zip = Archive::Zip->new();
			my $string_member = $zip->addString( ";A Pointlist of $globals{segmentname} for $wdaray[$wday], $abbr[$mon] $mday, $year -- Day number $daynumber : $crc\n", 'file_id.diz', COMPRESSION_DEFLATED );
			$string_member = $zip->addString( $pntlsttext, $zfname, COMPRESSION_DEFLATED );
			$zfname = "$config{pointlist}\.Z" . substr( $daynumber, 1, 2 );
			unless ( $zip->writeToFileNamed( $zfname ) == AZ_OK ) {
			    print STDERR "Error write $zfname.\n";
				writelog( "Error write $zfname." );
			}
			writelog( "$zfname saved." );
		}
	}
	if ( defined( $config{sendpointlistby} ) && defined( $config{sendpointlistto} ) ) {
		sendpointlist( "$config{pointlist}\.$daynumber" ) unless defined( $notsend );
	}

	writefile( $config{reportfile}, $globals{report} ) if defined $config{reportfile};

	if ( defined( $config{execafter} ) ) {
		$config{execafter} =~ s/\%pointlistz\%/$zfname/ig if defined $zfname;
		$config{execafter} =~ s/\%pointlist\%/"$config{pointlist}\.$daynumber"/ig;
		system $config{execafter} unless defined( $notsend );
	}
}


sub readworkdir()
{
	my ( $DH, $workfile, $digits, $key, $txt, $fname );

	if ( opendir( $DH, $config{workdir} ) ) {
		writelog( "Reading work dir $config{workdir}" );
		$globals{report} = '';
		while( readdir( $DH ) ) {
			if ( $_ =~ /^$config{segfilename}$/i ) {
				$workfile = catfile( $config{workdir}, $_ );
				$digits = 0;
				if ( $_ =~ /^([^\d\.]*?)(\d+)([^\d\.]*?)\..*$/ ) {
					$digits += $2;
					$fname = "$1$2$3";
					$filesfound{$digits} = sprintf( "%-9s", $fname );
					$txt = readfile( $workfile );
					if( $txt =~ /^\;A .*?(\d+)[ \-]*Day[ number]*(\d+).*/i ) {
						$filesfound{$digits} .= sprintf( " %4d -- Day number %3d" , $1, $2 );
					} else {
						my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
										 localtime( ( stat( $workfile ) )[10] );
#						$filesfound{$digits} .= sprintf( " %4d -- Day number %3d", $year + 1900, $yday );
						$filesfound{$digits} .= sprintf( " file date: %02d\.%02d\.%4d ", $mday, $mon + 1, $year + 1900 );
					}
				}
				readseg( $workfile );
			}
		}
		close( $DH );
		writelog( "Reading work dir done." );
		$globals{fileslist} = '';
		if ( defined( $config{region} ) && !defined( $config{net} ) ) {
			foreach $key ( sort keys %nets ) {
				$globals{fileslist} .= sprintf( ";S Net %-5d ", $key );
				if ( defined( $filesfound{$key} ) ) {
					$globals{fileslist} .= sprintf( "%-12s $nets{$key}\n",
													$filesfound{$key} );
				} else {
					$globals{fileslist} .= "not found ---------------------- $nets{$key}\n";
				}
			}
		}
		createpntlist();
# -- writeout seg ---
	}
}

sub readinbound( $ )
{
	my ( $inbound ) = @_;
	my ( $DH, $workfile, $inbfile, $backup, $found, $name, $ext, $workfiletime,
		$zip, $status, @fnames, $fname, $inbfiletime, $archname, $dirpos, $tic );

	if ( opendir( $DH, $inbound ) ) {
		$dirpos = telldir( $DH );
		writelog( "Reading $inbound" );
		print "Reading $inbound...\n";
		while( readdir( $DH ) ) {
			next unless $_ =~ /\.tic$/i;
			$tic = readfile( catfile( $inbound, $_ ) );
			$config{delzip} = 'no' if $tic =~ /$config{segfilename}/i;
		}
		seekdir( $DH, $dirpos );
		while( readdir( $DH ) ) {
			if ( $_ =~ /^$config{segfilename}$/i ) {
				writelog( "File $_ found." );
				next unless $_ =~ /(.+?)\.(.{3})/;
				( $name, $ext ) = ( $1, $2 );

				$workfile = catfile( $config{workdir}, uc( $name) . '.999' );
				$inbfile = catfile( $inbound, $_ );
				if ( $ext =~ /zip/i || $ext =~ /z\d\d/i ) {
					$archname = $inbfile;
					writelog( "   Unzip $_." );
					$zip = Archive::Zip->new();
					if ( -s $archname == 0 ) {
						writelog( "Deleting zero sized \'$archname\'." );
						writelog( "Error! Can't delete \'$archname\'." ) unless unlink $archname;
						next;
					}
					$status  = $zip->read( $archname );
					if ( $status != AZ_OK ) {
						move( $archname, "$archname\.bad" );
						writelog( "Read of $archname failed.");
						next;
					}
#					( @fnames ) = $zip->membersMatching( "\.[Pp][Kk][Tt]" );
					@fnames = $zip->memberNames();
					foreach $fname ( @fnames ) {
						if ( $fname =~ /^$config{segfilename}$/i ) {
							writelog( "Extracting $fname" );
							$inbfile = catfile( $config{unzipto}, $fname );
							$zip->extractMemberWithoutPaths( $fname, $inbfile );
							last;
						}
					}
					unlink $archname unless $config{delzip} eq 'no';
#					$inbfile = catfile( $inbound, $fname );
					writelog( "Now processing $inbfile." );
				}
				if ( -e $workfile ) {
					$workfiletime = read_pnt_time( $workfile );
					$inbfiletime = read_pnt_time( $inbfile );
#					if( $workfiletime <= $inbfiletime || $inbfiletime == 0 ) {
					if( $workfiletime <= $inbfiletime ) {
						$backup = catdir( $config{backupdir}, $globals{backdir} );
						mkdir( $backup ) unless -e $backup;
						copy( $workfile, catfile( $backup, uc( $name) . '.' . Time::HiRes::time() ) );
						copy( $inbfile, $workfile );
						writelog( "File $inbfile copied to $config{workdir}." );
					}
				} else {
					copy( $inbfile, $workfile );
					writelog( "File $inbfile copied to $config{workdir}." );
				}
				if( unlink( $inbfile ) ) {
					writelog( "File $inbfile deleted." );
				} else {
					writelog( "Can't delete $inbfile ($!)." );
				}
				$found = 1;
			}
		}
		closedir( $DH );
	} else {
		writelog( "Can't open $inbound ($!)." );
		print STDERR "Can't open $inbound ($!).\n";
		exit;
	}
#	readworkdir() if $found;
}

sub exportcfg()
{
	my ( $key );
#	print "----------config------------\n";
	foreach $key ( keys %config ) {
		print "$key = $config{$key}\n";
	}
#	print "----------regions------------\n";
#	foreach $key ( keys %regions ) {
#		print "$key = $regions{$key}\n";
#	}
#	print "----------nets------------\n";
#	foreach $key ( keys %nets ) {
#		print "$key = $nets{$key}\n";
#	}
	exit;
}

# --- MAIN ---
my $argline = join(' ', @ARGV);

GetOptions (
            "config=s"       => \$config,
            "help"           => \$needhelp,
            "ver"            => \$prinver,
            "whatsnew"       => \$whatsnew,
            "report-errors"  => \$reporterrors,
            "export"         => \$export,
            "update=s"       => \$check_updates,
            "not-send"       => \$notsend,
            "log=s"          => \$logfile)  # string
or die("Error in command line arguments\n");

	$check_updates = 'w' unless defined $check_updates;
	$check_updates = lc( $check_updates );

	if( $prinver ) {
		print "$0 $vers\n";
		update();
		exit;
	}

	whats_new() if $whatsnew;

	if ( $check_updates ne 'f' ) {
		usage() if $needhelp;
		usage() unless( defined( $config ) );
		readcfg( $config );
		exportcfg() if $export;
	}

    writelog( "Starting: $programfile $argline\n     Ver: $vers." );

	update();

	readndl( findndl( $config{nodelist} ) );

	readinbound( $config{inbound} ) if defined $config{inbound};

	scannetmail() if $config{scannetmail} eq 'yes';

	if ( defined $config{scanfileecho} ) {
		$config{delzip} = 'no';
		readinbound( $config{scanfileecho} );
	}

	readworkdir();