#!/usr/bin/perl
# 
# Author:       James Brister <brister@vix.com> -- berkeley-unix --
# Start Date:   Sat, 10 Oct 1998 21:40:11 +0200
# Project:      Private
# File:         suckNews.pl
# RCSId:        $Id: pullnews.in,v 1.1 1998/10/21 07:08:29 brister Exp $
# Description:  A very simple pull feeder. Connects to multiple remote 
#		machines (in the guise of a reader), and pulls over articles 
#		and feeds them to the local server (in the guise of a feeder).
# 		
# 		Uses a simple configuration file: $HOME/.pullnews to define
# 		which machines to pull articles from and which groups at each
# 		machine to pull over. There is no support yet for more specific
# 		configurations like cross-posted newsgroups to kill etc.
# 		
# 		A configuration file looks like:
# 		
# 			data.pa.vix.com
# 				news.software.nntp 0 0
# 				comp.lang.c 0 0
#			news.uu.net
#				uunet.announce 0 0
# 				uunet.help 0 0
# 		
# 		A hostname line has no leading space on it and all the
# 		subsequent group lines for that host must have leading
# 		spaces. The two integers on the group line will be updated by
# 		the program when it runs. They are the unix time the group was
# 		last accessed, and the highest numbered article that was pulled 
# 		over.
#
#
# NOTE NOTE NOTE NOTE:
#
# The Packages Net::NNTP is required *AND* the function Net::NNTP::new is 
# redefined in this file. If you're using a new release of Net::NTTP *AND* 
# if the Net::NNTP::new function supplied there does NOT call the 
# $obj->reader() function, then you can remove the redefinition in here.
#
# Net::NNTP is part of the libnet bundle by Graham Barr and is available from CPAN 
# or his site:
#
# 		http://www.connect.net/gbarr/
# 		

require 5.004;

my $rcsID =<<'EOM';
$Id: pullnews.in,v 1.1 1998/10/21 07:08:29 brister Exp $
EOM

$SIG{INT} = $SIG{QUIT} = \&outtaHere ;

use Net::NNTP;
use Getopt::Std ;

$opt_s = $opt_c = undef ;
getopts("c:s:q") ;

$groupFile = $opt_c || "$ENV{HOME}/.pullnews";
$localServer = $opt_s || "localhost" ;
$quiet = $opt_q ;

$| = 1 ;

my $servers = {} ;
my $sname = undef ;
my %fed = () ;
my $pulled = {} ;

open FILE, "<$groupFile" || die "cant open group file $groupFile\n" ;
while (<FILE>) {
    next if m!^\s*\#! || m!^\s*$! ;

    if (m!^(\S+)\s*$!) {
	$sname = $1 ;
	$servers->{$sname} = {} ;
    } elsif (m!^\s+(\S+)\s+(\d+)\s+(\d+)!) {
	($group,$date,$high) = ($1,$2,$3) ;
	$servers->{$sname}->{$group} = [ $date, $high ];
    } elsif (m!^\s+(\S+)\s*$!) {
	# assume this is a new group
	($group,$date,$high) = ($1,0,0) ;
	print "Looking for new group $group on $sname\n" unless $quiet ;
	$servers->{$sname}->{$group} = [ $date, $high ]; 
    } else { 
	die "Fatal error in $groupFile: $.: $_\n" ;
    }
}
close FILE ;

my @servers = (@ARGV || sort keys %$servers) ;

die "No servers!\n" if ! @servers ;

print "Connecting to downstream host $localServer..." unless $quiet;
my $localcxn = Net::NNTP->new($localServer) ||
    die "Cant connect to server $localServer\n" ;
print "done.\n" unless $quiet;

SEVER: 
foreach $server (@servers) {
    if (!exists($servers->{$server})) {
	warn "No such upstream host $server configured.\n" ;
	next ;
    }

    my $shash = $servers->{$server} ;

    print "connecting to upstream server $server..." unless $quiet ;
    my $upstream = Net::NNTP->new($server) ;

    if (!$upstream) {
	warn "cant connect to upstream server $server\n" ;
	next ;
    } else {
	print "done.\n" unless $quiet ;
    }

    if (!$upstream->reader()) {
	warn "Cant issue MODE READER command to $server. We'll try anyway\n" ;
    }

    foreach $group (sort keys %{$servers->{$server}}) {
	crossFeedGroup ($upstream,$localcxn,$group,$shash) ;
    }

    $upstream->quit() ;
}

$SIG{INT} = $SIG{QUIT} = 'IGNORE';

saveConfig () ;
stats() unless $quiet ;

exit (0) ;

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

sub stats {
    my $ltotal ;
    my $rtotal ;

    map { $ltotal += $fed{$_} } keys %fed ;
    printf "Fed %d articles to the local server\n",$ltotal ;
}

sub saveConfig {
    open FILE,">$groupFile" || die "cant open $groupFile: $!\n" ;
    my $server ;
    my $group ;

    print "Saving config\n" unless $quiet ;
    print FILE "# Format:\n" ;
    print FILE "# hostname\n" ;
    print FILE "# 	group date high\n" ;
    foreach $server (sort keys %$servers) {
	print FILE "$server\n" ;
	foreach $group (sort keys %{$servers->{$server}}) {
	    my ($date,$high) = @{$servers->{$server}->{$group}} ;
	    printf FILE "\t%s %d %d\n",$group,$date,$high ;
	}
    }
    close FILE ;
}


sub outtaHere {
    saveConfig() ;
    exit (0) ;
}

sub crossFeedGroup {
    my ($fromServer,$toServer,$group,$shash) = @_ ;
    my ($date,$high) = @{$shash->{$group}} ;
    my ($prevDate,$prevHigh) = @{$shash->{$group}} ;
    my ($narticles,$first,$last,$name) = $fromServer->group($group);
    my $count ;
    my $code ;
    
    printf "%s : %d %d %d\n", $name, $narticles, $first, $last ;
    
    return 0 if ! $narticles || ! $name ;

    if ($last <= $prevHigh) {
	# we connected OK but there's nothing there. Update our config values to 
	$shash->{$group} = [ time, $high ];
	return 1 ;
    }
    
    for ($i = ($first > $high ? $first : $high + 1) ; $i <= $last ; $i++) {
	$count++ ;
	$article = $fromServer->article($i) ;
	if ($article) {
	    my $msgid ;
	    
	    foreach my $line (@$article) {
		if ($line =~ m!^message-id:\s*(\S+)!i) {
		    $msgid = $1 ;
		    last ;
		}
	    }
	    
	    if (!$msgid) {
		warn "No message-id found in article\n" ;
		next ;
	    }
	    
	    $pulled->{$server}->{$group}++;
	    
	    if (!$toServer->ihave($msgid,$article)) {
		my $code = $toServer->code() ;
		if ($code != 435 && $code != 437) {
		    warn "Transfer to local server failed: ",
		    $toServer->message,"\n" ;
		    $toServer->quit() ;

		    saveConfig() ;
		    exit (1);
		}
		print "." unless $quiet;
	    } else {
		print "+" unless $quiet;
		$fed{$group}++ ;
	    }
	    
	    $shash->{$group} = [ time, $i ];
	} else {
	    print "x" unless $quiet;
	}
	print "\n" if (!quiet && ($count % 50 == 0)) ;
    }
    print "\n" unless $quiet;
}

package Net::NNTP ;

## Slightly modified implementation of the Net::NNTP::new function.  The
## original definition automatically sent a MODE READER command over which
## breaks when trying to feed INN via IHAVE.

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;
 my $host = shift if @_ % 2;
 my %arg  = @_;
 my $obj;

 $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};

 my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts};

 @{$hosts} = qw(news)
        unless @{$hosts};

 my $h;
 foreach $h (@{$hosts})
  {
   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
                            PeerPort => $arg{Port} || 'nntp(119)',
                            Proto    => 'tcp',
                            Timeout  => defined $arg{Timeout}
                                                ? $arg{Timeout}
                                                : 120
                           ) and last;
  }

 return undef
        unless defined $obj;

 ${*$obj}{'net_nntp_host'} = $host;

 $obj->autoflush(1);
 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);

 unless ($obj->response() == CMD_OK)
  {
   $obj->close;
   return undef;
  }

##++ brister removed the bit below.
## my $c = $obj->code;
## my @m = $obj->message;
##
## # if server is INN and we have transfer rights the we are currently
## # talking to innd not nnrpd
## if($obj->reader)
##  {
##   # If reader suceeds the we need to consider this code to determine postok
##   $c = $obj->code;
##  }
## else
##  {
##   # I want to ignore this failure, so restore the previous status.
##   $obj->set_status($c,\@m);
##  }
## ${*$obj}{'net_nntp_post'} = $c >= 200 && $c <= 209 ? 1 : 0;
##--

 $obj;
}

