#!/usr/local/bin/perl -U
#
#
# This script can change the flavor of outbound files and create empty
# FLO files.
#

require "getopts.pl";

&Getopts('vn');

##############################################################################
#
#
# Perl functions to read FIDOGATE config file,
# included by <INCLUDE config.pl> when running subst.pl
#

my %CONFIG;

# specials for DosDrive and Zone
my %CONFIG_dosdrive;
my %CONFIG_zone;



my %CONFIG_default =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"seq_pkt", "%V/seq/pkt",
	"dbc_history", "%V/bdc",
	"outpkt", "%S/outpkt",
	"spooldir", "/var/spool/fido/gate",
	"logfile", "%G/log",
	"uuinbound", "/var/spool/fido/bt/uuin",
	"outpkt_mail", "%S/outpkt/mail",
	"acl", "%C/acl",
	"lock_tic_hist", "tic_hist",
	"configdir", "/usr/local/etc/fido/gate",
	"history", "%V/history",
	"newsetcdir", "/usr/local/news/etc",
	"toss_toss", "%S/toss/toss",
	"netmaildir", "/var/spool/fido/bt/netmail",
	"ftnacl", "%C/ftnacl",
	"uplinks", "%C/uplinks",
	"seq_ff", "%V/seq/ff",
	"packing", "%C/packing",
	"outrfc_news", "%S/outrfc/news",
	"areas", "%C/areas",
	"newsbindir", "/usr/local/news/bin",
	"passwd", "%C/passwd",
	"hubroutedb", "%V/route",
	"aliases", "%C/aliases",
	"ftpinbound", "/var/spool/fido/bt/ftpin",
	"routing", "%C/routing",
	"logdir", "/var/log/fido/gate",
	"libexecdir", "/usr/local/libexec/fidogate",
	"tick_hold", "%B/tick",
	"seq_tick", "%V/seq/tick",
	"charsetmap", "%L/charset.bin",
	"toss_pack", "%S/toss/pack",
	"seq_msgid", "%V/seq/msgid",
	"config_main", "%C/fidogate.conf",
	"inbound", "/var/spool/fido/bt/in",
	"newsspooldir", "/usr/local/news/spool/articles",
	"seq_news", "%V/seq/news",
	"outpkt_news", "%S/outpkt/news",
	"spyes", "%C/spyes",
	"toss_bad", "%S/toss/bad",
	"outrfc_mail", "%S/outrfc/mail",
	"vardir", "/var/db/fidogate",
	"lock_history", "history",
	"hosts", "%C/hosts",
	"lockdir", "/var/run/fidogate",
	"newslibdir", "/usr/local/news",
	"tic_history", "%V/tic_hist",
	"lock_dbc", "dbc",
	"newsvardir", "/usr/local/news/db",
	"bindir", "/usr/local/bin",
	"seq_pack", "%V/seq/pack",
	"btbasedir", "/var/spool/fido/bt",
	"seq_toss", "%V/seq/toss",
	"config_gate", "%C/fidogate.conf",
	"inn_batchdir", "/usr/local/news/spool/outgoing",
	"pinbound", "/var/spool/fido/bt/pin",
	"toss_route", "%S/toss/route",
	"seq_mail", "%V/seq/mail",
	"seq_split", "%V/seq/split",
     );
my %CONFIG_abbrev =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"C", "configdir",
	"I", "inbound",
	"K", "lockdir",
	"B", "btbasedir",
	"P", "pinbound",
	"L", "libexecdir",
	"S", "spooldir",
	"G", "logdir",
	"N", "bindir",
	"V", "vardir",
     );



sub CONFIG_read {
    my($file) = @_;
    my($key, $arg);
    local *C;

    $file = CONFIG_expand($file);

    open(C,"$file") || die "config.pl: can't open config file $file\n";
    while(<C>) {
	chop;
	next if( /^\s*\#/ );	# comments
	next if( /^\s*$/  );	# empty
	s/\s*$//;		# remove trailing white space
	s/^\s*//;		# remove leading white space
	($key,$arg) = split(' ', $_, 2);
	$key =~ tr/A-Z/a-z/;
	if($key eq "include") {
	    CONFIG_read($arg);
	    next;
	}
	if($key eq "dosdrive") {
	    my ($d, $path) = split(' ', $arg);
	    $CONFIG_dosdrive{lc($d)} = $path;
	    next;
	}
	if($key eq "zone") {
	    my ($z, $rest) = split(' ', $arg, 2);
	    $CONFIG_zone{$z} = $rest;
	    next;
	}
	$CONFIG{$key} = $arg if(!$CONFIG{$key});
    }
    close(C);
}


sub CONFIG_get1 {
    my($key) = @_;
    my($ukey);

    $ukey = $key;
    $ukey =~ tr/a-z/A-Z/;
    return $ENV{"FIDOGATE_$ukey"} if($ENV{"FIDOGATE_$ukey"});

    return $CONFIG{$key} if($CONFIG{$key});
    return $CONFIG_default{$key};
}


sub CONFIG_get {
    my($key) = @_;
    my($ret);
    my($exp);

    $key =~ tr/A-Z/a-z/;
    return CONFIG_expand( CONFIG_get1($key) );
}


sub CONFIG_expand {
    my($v) = @_;
    my($exp);

    if($v =~ /^%([A-Z])/) {
	$exp = CONFIG_get1($CONFIG_abbrev{$1});
	$v =~ s/^%./$exp/;
    }

    return $v;
}


sub CONFIG_debug {    
    my($key);

    for $key (keys %CONFIG) {
	print "$key = $CONFIG{$key} -> ", CONFIG_get($key), "\n";
    }
}

##############################################################################

# read config
my $CONFIG = "%C/fidogate.conf";
CONFIG_read($CONFIG);

$BTBASEDIR    = CONFIG_get("BTBASEDIR");

# Configuration
$outdir  = "$BTBASEDIR/out";
$outzone = 2;
$defzone = 2;
$defrout = '2:5020/204';


$< = $>;

# Convert FIDO address to Binkley outbound name base

sub node2file {

    local($addr) = @_;
    local($zone,$net,$node,$point);
    local($dir,$nn,$pnt);

    if($addr =~ /^(\d+)\/(\d+)$/) {
	$zone  = $defzone;
	$net   = $1;
	$node  = $2;
	$point = 0;
    }
    elsif ($addr =~ /^(\d+):(\d+)\/(\d+)$/) {
	$zone  = $1;
	$net   = $2;
	$node  = $3;
	$point = 0;
    }
    elsif($addr =~ /^(\d+)\/(\d+)\.(\d+)$/) {
	$zone  = $defzone;
	$net   = $1;
	$node  = $2;
	$point = $3;
    }
    elsif ($addr =~ /^(\d+):(\d+)\/(\d+)\.(\d+)$/) {
	$zone  = $1;
	$net   = $2;
	$node  = $3;
	$point = $4;
    }
    else {
	print STDERR "out-manip: can't parse address $addr\n";
	exit 1;
    }

    if($zone != $outzone) {
	$dir = sprintf("$outdir.%03x", $zone);
    }
    else {
	$dir = $outdir;
    }
    $nn = sprintf("%04x%04x", $net, $node);
    if($point) {
	$pnt = sprintf(".pnt/0000%04x", $point);
    }
    else {
	$pnt = "";
    }

    return "$dir/$nn$pnt";
}



# Main

if($#ARGV < 0) {
    print STDERR "usage: out-manip [-vn] CMD Z:N/F.P ...\n";
    print STDERR "  CMD:   crash, direct, normal, hold, kill, poll, reroute\n";
    exit 1;
}

$cmd = shift;
$cmd =~ tr/[A-Z]/[a-z]/;

for $node (@ARGV) {

    $base = &node2file($node);

#    if( -f "$base.bsy" ) {
#	print STDERR "out-manip: node $node is busy, no changes.\n";
#	next;
#    }

    $old_flo = 0;
    if( -f "$base.clo" ) {
	$old_flo = "clo";
    }
    if( -f "$base.dlo" ) {
	$old_flo = "dlo";
    }
    if( -f "$base.flo" ) {
	$old_flo = "flo";
    }
    if( -f "$base.hlo" ) {
	$old_flo = "hlo";
    }
    $old_out = 0;
    if( -f "$base.cut" ) {
	$old_out = "cut";
    }
    if( -f "$base.dut" ) {
	$old_out = "dut";
    }
    if( -f "$base.out" ) {
	$old_out = "out";
    }
    if( -f "$base.hut" ) {
	$old_out = "hut";
    }

    if($cmd eq "poll") {
	$create_empty_flo = 1;
	$glob = "$base.\\\$\\\$?";
	@call = <${glob}>;
	if(@call) {
	    print "Removing call count @call\n" if($opt_v);
	    unlink(@call) unless($opt_n);
	}
    }

    if($cmd eq "crash" || $cmd eq "poll") {
	$new_flo = "clo";
	$new_out = "cut";
    }
    elsif($cmd eq "direct") {
	$new_flo = "dlo";
	$new_out = "dut";
    }
    elsif($cmd eq "normal") {
	$new_flo = "flo";
	$new_out = "out";
    }
    elsif($cmd eq "hold") {
	$new_flo = "hlo";
	$new_out = "hut";
    }
    elsif($cmd eq "kill") {
	print STDERR "out-manip: kill not yet implemented.\n";
	exit 1;
    }
    elsif($cmd eq "reroute") {
	$defrout = node2file($defrout);
	system "cat $base.dlo >> $defrout.dlo";
	unlink "$base.dlo";
	exit 0;
    }
    else {
	print STDERR "out-manip: unknown command $cmd.\n";
	exit 1;
    }

    # Rename outbound files
    if(!$old_flo) {
	if(!$old_out && $create_empty_flo) {
	    # No ?LO file yet - create.
	    $new = "$base.$new_flo";

	    print "$new\n" if($opt_v);
	    open(FLO, ">$new") || die "out-manip: can't open $base.$new_flo\n";
	    close(FLO);
	    chmod(0666, "$new");
	}
    }
    elsif($old_flo ne $new_flo) {
	$old = "$base.$old_flo";
	$new = "$base.$new_flo";

	print "$old -> $new\n" if($opt_v);
	if(!$opt_n) {
	    rename($old,$new)
		|| print STDERR "out-manip: rename $old -> $new failed.\n";
	}
    }

    if($old_out && $old_out ne $new_out) {
	$old = "$base.$old_out";
	$new = "$base.$new_out";

	print "$old -> $new\n" if($opt_v);
	if(!$opt_n) {
	    rename($old,$new)
		|| print STDERR "out-manip: rename $old -> $new failed.\n";
	}
    }
}
