#!/usr/pkg/bin/perl
#
# $Id: out-ls.pl,v 4.3 2001/01/04 20:03:43 mj Exp $
#
# This script lists the outbound of a FIDOGATE system
#

require 5.000;

my $PROGRAM = "out-ls";
 
use strict;
use Getopt::Std;
use FileHandle;

##############################################################################
#
# $Id: config.pl,v 4.4 2001/01/04 20:03:42 mj Exp $
#
# 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!!!##
	"hosts", "%C/hosts",
	"outrfc_mail", "%S/outrfc/mail",
	"configdir", "/usr/pkg/etc/fidogate",
	"seq_tick", "%V/seq/tick",
	"outpkt_mail", "%S/outpkt/mail",
	"acl", "%C/acl",
	"newsspooldir", "/var/news/spool/articles",
	"seq_pkt", "%V/seq/pkt",
	"logdir", "/var/log/fido",
	"config_ffx", "%C/fidogate.conf",
	"newsetcdir", "/var/news/etc",
	"passwd", "%C/passwd",
	"toss_pack", "%S/toss/pack",
	"seq_mail", "%V/seq/mail",
	"pinbound", "/var/spool/bt/pin",
	"config_gate", "%C/fidogate.conf",
	"toss_bad", "%S/toss/bad",
	"outpkt", "%S/outpkt",
	"tick_hold", "%B/tick",
	"libdir", "/usr/pkg/lib/fidogate",
	"vardir", "/var/spool/fido",
	"seq_news", "%V/seq/news",
	"routing", "%C/routing",
	"ftpinbound", "/var/spool/bt/ftpin",
	"newslibdir", "/usr/pkg/inn/lib",
	"seq_toss", "%V/seq/toss",
	"history", "%V/history",
	"toss_route", "%S/toss/route",
	"seq_split", "%V/seq/split",
	"seq_ff", "%V/seq/ff",
	"areas", "%C/areas",
	"btbasedir", "/var/spool/bt",
	"lockdir", "/var/spool/fido/lock",
	"aliases", "%C/aliases",
	"lock_history", "history",
	"seq_msgid", "%V/seq/msgid",
	"outrfc_news", "%S/outrfc/news",
	"inbound", "/var/spool/bt/in",
	"packing", "%C/packing",
	"outpkt_news", "%S/outpkt/news",
	"ifmaildir", "/usr/pkg/sbin",
	"newsvardir", "/var/news",
	"seq_pack", "%V/seq/pack",
	"toss_toss", "%S/toss/toss",
	"config_main", "%C/fidogate.conf",
	"bindir", "/usr/pkg/lib/fidogate/bin",
	"uuinbound", "/var/spool/bt/uuin",
	"logfile", "%G/log",
	"spooldir", "/var/spool/fido",
	"charsetmap", "%L/charset.bin",
     );
my %CONFIG_abbrev =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"C", "configdir",
	"I", "inbound",
	"N", "bindir",
	"K", "lockdir",
	"U", "uuinbound",
	"P", "pinbound",
	"L", "libdir",
	"V", "vardir",
	"G", "logdir",
	"B", "btbasedir",
	"S", "spooldir",
     );



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

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

use vars qw($opt_v $opt_c $opt_p);
getopts('vc:p');

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



my $OUTBOUND = "/var/spool/bt";
my $z;
my $out;

for $z (sort keys %CONFIG_zone) {
    $out = $OUTBOUND . "/" . (split(' ', $CONFIG_zone{$z}))[2];
    do_dir($z, $out) if(-d $out);
}

exit 0;




sub file2addr {
    my ($zone, $name) = @_;

    my $net   = hex(substr($name,  0, 4));
    my $node  = hex(substr($name,  4, 4));
    my $point = hex(substr($name, 17, 4));

    if($point != 0) {
	return "$zone:$net/$node.$point";
    }
    else {
	return "$zone:$net/$node";
    }
}



sub do_file {
    my ($zone, $dir, $file) = @_;

    my ($flavor, $isflo, $isout, $addr, $t, $s, $n);

    if($file =~ /pnt/) {
	$flavor = substr($file, 22, 3);
    }
    else {
	$flavor = substr($file, 9, 3);
    }
    $flavor =~ tr/a-z/A-Z/;
    $isflo  =  $file =~ /\..lo$/;
    $isout  =  $file =~ /\..ut$/;
    $addr   =  file2addr($zone, $file);

    print $flavor, " ";
    printf "%-45.45s (%s)\n", $addr . " " . "-" x 45, $file;

    if($isflo) {
	open(FLO, "$dir/$file")
	  || die "$PROGRAM: can't open $dir/$file: $!";
	$s = 0;
	$n = 0;
	while(<FLO>) {
	    s/\cM?\cJ$//;
	    next if( /^;/ );
	    $s += print_flo_entry( $dir, $_ );
	    $n++;
	}
	print "    ", ksize($s), "\n" if $n>1;
    }
    if($isout) {
	($s, $t) = size_time("$dir/$file");
	print "    ";
	print ksize($s),   "  ";
	print asctime($t), "  ";
	print "\n";
    }
}



sub print_flo_entry {
    my ($dir, $line) = @_;

    my ($type, $drive, $file, $short, $t, $s);

    $type  = substr($line, 0, 1);
    if($type =~ /[\#~^]/ ) {
	$line = substr($line, 1, length($line)-1);
    }
    else {
	$type = " ";
    }

    if($line =~ /^[A-Z]:\\/i) {
	$line  =~ tr/[A-Z\\]/[a-z\/]/;
	$drive =  substr($line, 0, 2);
	$file  =  substr($line, 2, length($line)-2);
	$file  =  $CONFIG_dosdrive{$drive}.$file;
    }
    else {
	$file  = $line;
    }
    $short =  $file;
    $short =~ s+^$dir/++;

    ($s, $t) = size_time($file);

    print "    ";
    print ksize($s),   "  ";
    print asctime($t), "  ";
    print $type, " ", $short, "\n";

    return $s;
}



sub asctime {
    my ($time) = @_;

    if($time eq "") {
	return "              ";
    }
    else {
	my ($yr, $mn, $dy, $h, $m, $s);

	($s,$m,$h,$dy,$mn,$yr) = localtime($time);

	return sprintf("%02d.%02d.%02d %02d:%02d", $dy,$mn+1,$yr%100,$h,$m);
    }
}



sub size_time {
    my ($file) = @_;

    return (stat($file))[7,9];
}



sub ksize{
    my ($size) = @_;

    my ($k);

    if($size eq "") {
	return "   N/A";
    }
    else {
	if($size == 0) {
	    $k = 0;
	}
	elsif($size <= 1024) {
	    $k = 1;
	}
	else {
	    $k = $size / 1024;
	}
	return sprintf("%5dK", $k);
    }
}



sub do_point_dir {
    my ($zone, $dir, $pdir) = @_;

    opendir(DIR, "$dir/$pdir")
      || die "$PROGRAM: can't open $dir/$pdir: $!";
    my @files = readdir(DIR);
    closedir(DIR);
    @files = sort(@files);

    for(@files) {
	if( /^0000[0-9a-f]{4}\.(.lo|.ut|bsy)$/ ) {
	    do_file($zone,$dir,"$pdir/$_");
	}
    }
}



sub do_dir {
    my ($zone, $dir) = @_;

    print "zone=$zone, dir=$dir\n" if($opt_v);

    opendir(DIR, $dir)
      || die "$PROGRAM: can't open $dir: $!";
    my @files = readdir(DIR);
    closedir(DIR);
    @files = sort(@files);

    for(@files) {
	if( /^[0-9a-f]{8}\.(.lo|.ut|bsy|\$\$.)$/ ) {
	    do_file($zone,$dir,$_);
	}
	if( !$opt_p && /^[0-9a-f]{8}\.pnt$/ ) {
	    do_point_dir($zone,$dir,$_);
	}
    }
}
