#!/usr/bin/perl

use POSIX qw(strftime);

# read config
#open C, "</usr/local/etc/ftn.conf";
#while(<C>) {
#    if( /^Queue (.*)/ ) {
#	$queue=$1;
#    } elsif( /^Queue (.*)/ ) {
#	$queue=$1;
#    }
$ftn="/var/spool/ftn";
$areacfg="/var/fidogate/fareas.bbs";
$passfile="/usr/local/etc/bforce.passwd";
$passfile2="/usr/local/etc/fidogate-passwd";
$inb="$ftn/toss-tic";
$addr="2:5020/12000";
$log="/var/log/ftn/tic.log";
$fbox="$ftn/fbox";
$ticnum="/var/spool/ftn/tick.n";
$events="/usr/local/etc/tic.event"; # area\tfile\tcommand

# keywords in lowercase
$single=" area areadesc file fullname crc magic size date release author source origin from to created pw pgp ";
$multi=" desc ldesc via path seenby app replaces ";
$noparm=" receiptrequest ";

# read fecho-file

# -r read-only
# -w write-only
# -i allow insecure posts

open A,"<$areacfg";
<A>;
while(<A>) {
    #print "Line: $_";
    split /\s+/;
    if( $#_ < 1 ) {
	print "Bad config line\n";
	exit -1;
    }
    $area=uc(@_[1]);
    if( exists $path{$area} ) {
	print "Duplicate area $area\n";
	exit -1;
    }
    $path{$area}=@_[0];
    system( "mkdir", "-p", $path{$area} );
    $i=2;
    while( @_[$i] =~ /^-/ ) {
	$opt{$area}.=" ".@_[$i]." ".@_[$i+1];
	$i+=2;
    }
    #print $area." ";
    for( $z=0, $n=0, $f=0; $i<=$#_; $i++ ) {
        $_=@_[$i];
	#print "($_)";
	if( /^(\d+):(\d+)\/(\d+)$/ ) {
	    $z=$1; $n=$2; $f=$3; $p=0;
	    #print "3D ";
	}
	elsif( /^(\d+)\/(\d+)$/ ) {
	    $n=$1; $f=$2; $p=0;
	    #print "N3D ";
	}
	elsif( /^(\d+)$/ ) {
	    $f=$1; $p=0;
	    #print "F3D ";
	}
	elsif( /^(\d+):(\d+)\/(\d+)\.(\d+)$/ ) {
	    $z=$1; $n=$2; $f=$3; $p=$4;
	    #print "4D ";
	}
	elsif( /^(\d+)\/(\d+)\.(\d+)$/ ) {
	    $n=$1; $f=$2; $p=$3;
	    #print "N4D ";
	}
	elsif( /^(\d+)\.(\d+)$/ ) {
	    $f=$1; $p=$2;
	    #print "F4D ";
	}
	elsif( /^\.(\d+)$/ ) {
	    $p=$1;
	    #print "P4D ";
	}
	else {
	    print "bad address in config\n";
	    exit -1;
	}
	#print "$z:$n/$f.$p ";
	$links{$area}.="$z:$n/$f".($p?".$p":"")." ";
	
    }
    #print "\n";
}
close A;

# read passwords

open P,"<$passfile";
while(<P>) {
    if( /^password\s+(\S+)\s+(\S+)/ ) {
	$node=$1;
	$pass=$2;
	$node=$1 if( $node =~ /^(.*)\.0$/ );
	$pass{$node}=uc($pass);
	#print "$node $pass\n";
    }
}
close P;

open P,"<$passfile2";
while(<P>) {
    if( /^ff\s+(\S+)\s+(\S+)/ ) {
	$node=$1;
	$pass=$2;
	$node=$1 if( $node =~ /^(.*)\.0$/ );
	$pass{$node}=uc($pass);
	#print "$node $pass\n";
    }
}
close P;


# toss
tic: for $tic (<$inb/*.[Tt][Ii][Cc]>) {
    print "Tossing $tic...\n";
    # read & check
    undef %value;
    undef %list;
    undef %flag;
    undef @unkn;
    open F,"<$tic";
    while(<F>) {
	if( ! /^(\S+)(.*)/ ) {
	    print "failed to parse\n";
	    next tic;
	}
	$keyword=lc($1);
	$parm=$2;
	$parm =~ s/[\12\15]/ /g;
	$parm =~ s/^\s+//;
	$parm =~ s/\s+$//;
	if( $single =~ / $keyword / ) {
	    #print "Single $keyword\n";
	    if( exists $value{$keyword} ) {
		print "Duplicate keyword $keyword\n";
		next tic;
	    }
	    $value{$keyword}=$parm;
	} 
	elsif( $multi =~ / $keyword / ) {
	    #print "Multi $keyword\n";
	    $list{$keyword}.=$parm."\n";
	}
	elsif( $noparm =~ / $keyword / ) {
	    #print "Flag $keyword\n";
	    if( ! ($parm eq "") ) {
		print "Unexpected data after $keyword\n";
		next tic;
	    }
	    $flag{$keyword}=1;
	}
	else {
	    #print "Unknown $keyword\n";
	    @unkn{$#unkn+1}="$keyword $parm\n";
	}
    }
    close F;

    # Check TO
    
    if( exists $value{"to"} && !($value{"to"} eq $addr) ) {
	print "tic not for us\n";
	next tic;
    }

    # Check FROM, PW

    if( !exists $value{"from"} ) {
	print "unknown tic sender\n";
	next tic;
    }
    
    $from=$value{"from"};
    
    undef $ticpass;
    $ticpass=uc($value{"pw"}) if( exists $value{"pw"} );
    if( $from =~ /^(\S+)\s+(\S+)$/ ) {
	$from=$1;
	if( defined $ticpass ) {
	    if( ! ($ticpass eq uc($2)) ) {
		print "passwords PW and FROM differs\n";
		next tic;
	    }
	}
	else {
	    $ticpass=uc($2);
	}
    }
    elsif( ! ($from=~/^\S+$/) ) {
	print "bad FROM\n";
	next tic;
    }
    
    if( exists $pass{$from} && ! ($pass{$from} eq $ticpass) ) {
	print "bad password\n";
	next tic;
    }
    
    print "From: $from\n";

    # Check AREA

    if( !exists $value{"area"} || !exists $value{"file"} || !exists $value{"crc"} ) {
	print "incomplete tic\n";
	next tic;
    }

    $area=uc($value{"area"});
    
    if( ! exists $path{$area} ) {
	print "Unknown area\n";
	next tic;
    }

    print "Area: $area\n";

    # Check subscription status
    
    #print $from."/////".$links{$area}."\n";
    
    if( ! ( $links{$area} =~ /(^|\s)$from($|\s)/ ) and ! ($from eq $addr) ) {
	print "Link $from not subscribed to $area\n";
	next tic;
    }
    
    # Check FILE, SIZE, CRC
    
    $file=$value{"file"};
    
    # file - name 8.3; fullname - fullname if there is it in .tic
    # lname - name of file in inbound
    # fname - name of file in storage

#    if( ! ($file =~ /^[A-Za-z0-9\@\&\=\+\%\$\-\_\.\!\(\)\#\|\~]{1,8}\.[A-Za-z0-9\@\&\=\+\%\$\-\_\.\!\(\)\#\|\~]{1,3}$/) ) {
    if( ! ($file =~ /^[A-Za-z0-9\@\&\=\+\%\$\-\_\.\!\(\)\#\|\~\']+$/) ) {
	print "Bad file name\n";
	next tic;
    }
    if( $file =~ /\.tic$/i ) {
	print "Cannot hatch tic\n";
	next tic;
    }
    
    $crc=$value{"crc"};
    $size=$value{"size"};
    
    print "File: $file $size $crc\n";

    # 1. match case insensitive
    # 2. match 4 letters
    # 3. full search

    undef %infiles;
    for(<$inb/*>) {
	next if( /\.tic$/ );
	@s=stat;
	$infiles{$_}=$s[7]; #file size
    }

    check: {
	for (keys %infiles) {
	    /(.*?)([^\/]*)$/;
	    if( uc($file) eq uc($2) ) {
		#print "try1 $2\n";
		$fnm=quotemeta;
		if( substr(uc(`sumcrc -x3 $fnm`),0,8) eq uc($crc) ) {
		    #print "found $2\n";
		    $lfile=$2;
		    last check;
		}
		delete $infiles{$_};
	    }
	}

	for (keys %infiles) {
	    /(.*?)([^\/]*)$/;
	    if( substr(uc($file),0,4) eq substr(uc($2),0,4) ) {
		#print "try2 $2\n";
		$fnm=quotemeta;
		if( substr(uc(`sumcrc -x3 $fnm`),0,8) eq uc($crc) ) {
		    #print "found $2\n";
		    $lfile=$2;
		    last check;
		}
		delete $infiles{$_};
	    }
	}


	# if crc is 00000000, do not do try3
	if( $crc ne "00000000" ) {
	#guess all files
	for (keys %infiles) {
	    /(.*?)([^\/]*)$/;
	    print "try3 $2\n";
	    $fnm=quotemeta;
	    if( substr(uc(`sumcrc -x3 $fnm`),0,8) eq uc($crc) ) {
		#print "found $2\n";
		$lfile=$2;
		last check;
	    }
	}
	}

	print "No file found\n";
	next tic;
    }
    
    print "Inbound file $lfile\n";
    #print "--------\n";
    #print $path{$area}."\n";
    #print $links{$area}."\n";
    #print $opt{$area}."\n";
    #print "--------\n";

    # fullname
    
    if( exists $value{"fullname"} ) {
	$fname=$value{"fullname"};
	if( $fname =~ /\// ) {
	    print "slash in full file name, possible attack\n";
	    next tic;
	}
    } else {
	$fname=$file;
    }

    # replace

    undef @replace;
    if( exists $list{"replaces"} ) {
        if( ($list{"replaces"} =~ /^\*/) or ($list{"replaces"} =~ /\s\*/) ) {
            print "Wildcard replace!\n";
            next tic;
        }
	@replace=split /\n/, $list{"replaces"};
    }

    # move to filearea storage

    if( defined @replace ) {
	for(@replace) {
	    print "Replace $_\n";
	    for(<$path{$area}/$_>) {
		next if( /\.info$/ or /\.desc$/ );
		print "remove $_\n";
		system "rm", $_ if( -e $_ );
		system "rm", $_.'.desc' if( -e $_.'.desc' );
		system "rm", $_.'.info' if( -e $_.'.info' );
	    }
	}
    }

    $cpfrom=$inb."/".$lfile;
    $cpto=$path{$area}."/".$fname;
    print("cp <$cpfrom> <$cpto>\n");
    $cparch=$cpto;
    $cparch=~s/\/areas\//\/areas_archive\//;
    if( (-e $cpto) or (-e $cparch) ) {
        $oldfile=$cparch if( -e $cparch );
        $oldfile=$cpto if( -e $cpto );
        print "File already exists - $oldfile\n";
        $ocrc=substr(uc(`/usr/local/bin/sumcrc -x3 "$oldfile"`),0,8);
        chomp $ocrc;
        if( $ocrc =~ /^.{8}$/ ) {
            print "Old CRC: [$ocrc] new CRC: [$crc]\n";
            if( uc($orcr) eq uc($crc) ) {
                print "Same\n";
                next tic;
            }
            print "Changed\n";
        } else {
            print "Invalid CRC\n";
            next tic;
        }
    }
    if( system("cp", $cpfrom, $cpto)!=0 ) {
	print "File copy <$cpfrom> -> <$cpto> failed\n";
	next tic;
    }
    if( defined $value{"date"} ) {
	print "setting date ".localtime($value{"date"})." on file\n";
	utime $value{"date"}, $value{"date"}, "$path{$area}/$fname";
    }
    
    open D, ">$path{$area}/$fname.desc";
    print D $list{"desc"};
    print D "-\n" if( exists $list{"ldesc"} );
    print D $list{"ldesc"};
    close D;
    
    open I, ">$path{$area}/$fname.info";
    print I "AREA: $area\n";
    print I "AREADESC: $value{\"areadesc\"}\n" if( exists $value{"areadesc"} );
    print I "RECEIVED AS: $file\n";
    print I "RECEIVED FROM: $from".(exists $value{"created"}?" (exported $value{\"created\"})":"")."\n";
    print I "ORIGIN: $value{\"origin\"}\n" if( exists $value{"origin"} );
    print I "CRC: $crc\n";
    print I "DECLARED SIZE: $value{\"size\"}\n" if( exists $value{"size"} );
    print I "FREQ AS: $value{\"magic\"}\n" if( exists $value{"magic"} );
    print I "FILE DATE: ".localtime($value{"date"})."\n" if( exists $value{"date"} );
    print I "RELEASE DATE: $value{\"release\"}\n" if( exists $value{"release"} );
    print I "AUTHOR: $value{\"author\"}\n" if( exists $value{"author"} );
    print I "SOURCE: $value{\"source\"}\n" if( exists $value{"source"} );
    print I "PGP: $value{\"pgp\"}\n" if( exists $value{"pgp"} );
    print I "FLAGS:".($flag{"receiptrequest"}==1?" ReceiptRequest":"")."\n" if( defined %flag );
    print I "REPLACED ->\n".$list{"replaces"} if( exists $list{"replaces"} );
    print I "PATH ->\n".$list{"path"} if( exists $list{"path"} );
    print I "VIA ->\n".$list{"via"} if( exists $list{"via"} );
    print I "SEENBY ->\n".$list{"seenby"} if( exists $list{"seenby"} );
    print I "APPDATA ->\n".$list{"app"} if( exists $list{"app"} );
    close I;

    # log
    open L,">>$log";
    print L strftime( "%Y-%m-%d %H:%M:%S", localtime );
    print L " from $from file $fname area $area".(defined @replace?" replaces ".join(' ',@replace):"")."\n";
    close L;
        
    # process: add seenby, via, path

    undef %export;
    undef %newseenby;
    for( split /\s+/, $links{$area} ) {
	$newseenby{$_}=1;
	$export{$_}=1;
    }
    
    for( split /\s+/, $list{"seenby"} ) {
	s/\.0$//;
	$newseenby{$_}=1;
	delete $export{$_};
    }
    
    delete $export{$from};
    delete $export{$addr};
    
    if( ($area =~ /^FLUID/) and ! ($area eq "FLUID.TECH") ) {
        undef %export; # NO EXPORT
        $export{"2:5020/12000.10"}=1;
    }

    print "Export: ".(join ' ', keys %export)."\n";

    open N,"<$ticnum";
    $num=<N>;
    close N;
    open N,">$ticnum";
    print N ($num==999999?0:$num+1)."\n";
    close N;

    # export
    linkexport: for $dest ( keys %export ) {
	print "export to $dest... ";
	$outdir=$dest;
	$outdir =~ s/[:\/]/\./g;
	$outdir.=".0" if( (split /\./, $outdir) == 3 );
        #print "Makedir $fbox/$outdir\n";
	system( "mkdir", "-p", "$fbox/$outdir" );

        $lnum=$num; $maxrenames=1000;
	while( -e ($tickname=sprintf "$fbox/$outdir/PL%06d.TIC", $lnum) ) {
            $lnum++;
            print "skip $tickname\n";
            if( --$maxrenames == 0 ) {
                print "emergency exit\n";
                next linkexport;
            }
        }
        #print "$tickname\n";

        print "file ";
        $ofile=$file; $maxrenames=1000;
        while( !symlink("$path{$area}/$fname", "$fbox/$outdir/$ofile") ) {
            print "failed to put file $ofile in outbox\n";
            if( readlink("$fbox/$outdir/$ofile") eq "$path{$area}/$fname" ) {
                print "already exported\n";
                next linkexport;
            }
            if( $ofile=~/^(.*?)([a-zA-Z]*[0-9]*)$/ ) {
                $modify=$2;
                $modify++;
                $ofile=$1.$modify;
            }
            if( --$maxrenames == 0 ) {
                print "emergency exit\n";
                next linkexport;
            }
        }
        
        print "tic ";
	if( !open T,">$tickname" ) {
	    print "failed to create tic file\n";
	    next linkexport;
	}
	print T "AREA $area\r\n";
	print T "AREADESC $value{\"areadesc\"}\r\n" if( exists $value{"areadesc"} );
	print T "FILE $file\r\n";
	print T "FULLNAME $value{\"fullname\"}\r\n" if( exists $value{"fullname"} );
	print T "CRC $crc\r\n";
	print T "MAGIC $fname\r\n";
	if( exists $list{"replaces"} ) {
	    for( split /\n/, $list{"replaces"} ) {
		print T "REPLACES $_\r\n";
	    }
	}
	if( exists $list{"desc"} ) {
	    for( split /\n/, $list{"desc"} ) {
		print T "DESC $_\r\n";
	    }
	}
	if( exists $list{"ldesc"} ) {
	    for( split /\n/, $list{"ldesc"} ) {
		print T "LDESC $_\r\n";
	    }
	}
	print T "SIZE $value{\"size\"}\r\n" if( exists $value{"size"} );
        print T "DATE $value{\"date\"}\r\n" if( exists $value{"date"} );
	print T "RELEASE $value{\"release\"}\r\n" if( exists $value{"release"} );
	print T "AUTHOR $value{\"author\"}\r\n" if( exists $value{"author"} );
	print T "SOURCE $value{\"source\"}\r\n" if( exists $value{"source"} );
	if( exists $list{"app"} ) {
	    for( split /\n/, $list{"app"} ) {
		print T "APP $_\r\n";
	    }
	}
        print T "ORIGIN $value{\"origin\"}\r\n" if( exists $value{"origin"} );
	print T "FROM $addr\r\n";
	print T "TO $dest\r\n";
	print T "CREATED by perl script\r\n";
	if( exists $list{"via"} ) {
	    for( split /\n/, $list{"via"} ) {
		print T "VIA $_\r\n";
	    }
	    print T "VIA $from ".(exists $value{"created"}?$value{"created"}:"by unknown")."\r\n";
	}
	if( exists $list{"path"} ) {
	    for( split /\n/, $list{"path"} ) {
		print T "PATH $_\r\n";
	    }
	}
	print T "PATH $addr ".time." ".gmtime()." UTC \r\n";
	for( sort keys %newseenby ) {
	    print T "SEENBY $_\r\n";
	}
        print T "PW $pass{$dest}\r\n" if( exists $pass{$dest} );
	print T "PGP $value{\"pgp\"}\r\n" if( exists $value{"pgp"} );
	print T "RECEIPTREQUEST\r\n" if( $flag{"receiptrequest"}==1 );
        close T;
        
        print "zip ";
        if( $dest eq "2:5020/166" ) {
            print "ZIP $fbox/$outdir/$ofile and $tickname\n";
	    $zipname=$tickname;
	    $zipname=~s/TIC$/ZIC/;
	    system("cd $fbox/$outdir ; zip -j -m $zipname $ofile $tickname");
        }
        print "ok\n";
    }
    
    # remove file and tic
    system "rm", "$inb/$lfile", "$tic";
    print "ok\n";
}