#!/usr/local/bin/perl -w
#
#
# Syncronize groups between areas.bbs, active, sucknewsrc, NNTP list
#

use strict;

my $VERSION = '$Revision: 5.2 $ ';
my $PROGRAM = "areasbbssync";

use Getopt::Std;
use FileHandle;
use IO::Socket;

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



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

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



# command line options
use vars qw($opt_v $opt_h $opt_c $opt_A $opt_B $opt_S $opt_N $opt_P
	    $opt_n $opt_g);
getopts('vhc:A:B:S:N:P:n:g:');
die
  "usage:   areasbbssync [-v] [-c GATE.CONF]\n",
  "                      [-A ACTIVE] [-B AREAS.BBS] [-S SUCKNEWSRC]\n",
  "                      [-N NEWSSERVER] [-P PATTERN] [-g WILDCARD]\n",
  "\n",
  "options: -v              verbose\n",
  "         -h              this help\n",
  "         -c CONF         alternate config file\n",
  "         -A ACTIVE       alternate active file\n",
  "         -B AREAS.BBS    alternate areas.bbs file\n",
  "         -S SUCKNEWSRC   alternate sucknewsrc file\n",
  "         -N NEWSSERVER   alternate news (NNTP) server\n",
  "         -P PATTERN      must match pattern (regex)\n",
  "         -g GROUP.*,...  INN-style wildcard newsgroup pattern\n",
  "         -n N            max. N articles from newly sucked groups\n"
  if($opt_h);



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

my $ACTIVE	 = $opt_A ? $opt_A : CONFIG_get("NewsVarDir") . "/active";
my $AREAS 	 = $opt_B ? $opt_B : CONFIG_get("AreasBBS");
my $SUCK         = $opt_S ? $opt_S : "/var/lib/suck/sucknewsrc";
my $SERVER       = $opt_N ? $opt_N : "localhost";
my $PATTERN      = $opt_P ? $opt_P : "^(de)\\.";
my $MAX          = $opt_n ? $opt_n : 50;

my $FTNAFUTIL    = CONFIG_get("BinDir") . "/ftnafutil -b$AREAS listgwlinks";


if($opt_g) {
    $PATTERN = $opt_g;
    $PATTERN =~ s/\./\\./g;
    $PATTERN =~ s/,/|/g;
    $PATTERN =~ s/\*/.*/g;
    $PATTERN = "^($PATTERN)";

    print "PATTERN = $PATTERN\n" if($opt_v);
}



##### main ###################################################################

my %nntp_list_count;
my %nntp_list_type;
my %suck_list;
my %active_list_count;
my %active_list_type;
my %areas_list;

my $sock;
my $resp;
my ($group, $n, $type);
local(*F);
local(*P);


#----- get list of newsgroups from server ------------------------------------
print "Connecting to $SERVER:nntp ...\n" if($opt_v);
$sock = new IO::Socket::INET(PeerAddr => $SERVER,
			     PeerPort => "nntp",
			     Proto    => "tcp",
			     Type     => SOCK_STREAM)
  || die "$PROGRAM: can't open NNTP connection to $SERVER: $!\n";
$sock->autoflush(1);

$resp = <$sock>;
$resp =~ s/\cM?\cJ?$//;
print "Greeting: $resp\n" if($opt_v);
die "$PROGRAM: unexpected \"$resp\" from $SERVER\n"
  unless($resp =~ /^200 /);

print "Listing newsgroups ...\n" if($opt_v);				 
print $sock "list\r\n";
$resp = <$sock>;
$resp =~ s/\cM?\cJ?$//;
print "Reply: $resp\n" if($opt_v);

do {
    $resp = <$sock>;
    $resp =~ s/\cM?\cJ?$//;
#    print "list: $resp\n" if($opt_v);

    ($group, $n, undef, $type) = split(' ', $resp);
    if($group =~ /$PATTERN/) {
	print "nntp group $group\n" if($opt_v);
	$nntp_list_count{$group} = $n + 0;
	$nntp_list_type {$group} = $type;
    }
} while($resp && $resp ne ".");

close($sock);


#----- get newsgroups from sucknewsrc ----------------------------------------
open(F, "<$SUCK")
  || die "$PROGRAM: can't open $SUCK: $!\n";

while(<F>) {
    s/\cM?\cJ?$//;
    next if(/^\s*\#/);

    ($group, $n) = split(' ');
    if($group =~ /$PATTERN/) {
	print "suck group $group\n" if($opt_v);
	$suck_list{$group} = $n;
    }
}

close(F);


#----- get local active newsgroups -------------------------------------------
open(F, "<$ACTIVE")
  || die "$PROGRAM: can't open $ACTIVE: $!\n";

while(<F>) {
    s/\cM?\cJ?$//;
    next if(/^\s*\#/);

    ($group, undef, $n, $type) = split(' ');
    if($group =~ /$PATTERN/) {
	print "active group $group\n" if($opt_v);
	$active_list_count{$group} = $n + 0;
	$active_list_type {$group} = $type;
    }
}

close(F);


#----- get areas from areas.bbs ----------------------------------------------
open(P, "$FTNAFUTIL|")
  || die "$PROGRAM: can't open pipe to $FTNAFUTIL: $!\n";

while(<P>) {
    s/\cM?\cJ?$//;
    
    ($group, undef, $n) = split(' ');
    $group = lc($group);
    $group =~ tr/_/-/;		# FIXME: this really should be removed
    print "line=$_ / group=$group n=$n\n" if($opt_v);
    if($group =~ /$PATTERN/) {
	print "areas.bbs group $group\n" if($opt_v);
	$areas_list{$group} = $n;
    }
}

close(P)
  || die "$PROGRAM: error in pipe to $FTNAFUTIL: $!\n";



#----- check areas with link against sucknewsrc ------------------------------
for $group (sort keys %areas_list) {
    next unless($areas_list{$group} > 0);

    print "checking areas.bbs $group\n" if($opt_v);
    if($suck_list{$group}) {
	print "                   already in sucknewsrc\n" if($opt_v);
	$n = $suck_list{$group};
    }
    else {
	print "                   not in sucknewsrc\n" if($opt_v);
	$n = $nntp_list_count{$group};
	unless($n) {
	    print "                   not in NNTP list, skipping\n" if($opt_v);
	    next;
	}
	$n -= $MAX;
	$n = 1 if($n < 1);
    }

    ##FIXME: write directly to sucknewsrc
    print "$group $n\n";
}



exit 0;
