#! /usr/bin/perl -w
#
# Date: 26 Jun 1999 17:59:00 +0200
# From: kaih=7Jbfpa7mw-B@khms.westfalen.de (Kai Henningsen)
# Newsgroups: news.software.nntp
# Message-ID: <7Jbfpa7mw-B@khms.westfalen.de>
# Subject: Re: Version of pullnews that support authentication?
#
# [...]
# I'm appending a script I wrote (called backupfeed.pl for some reason). Hmm  
# ... oh, I hereby put that into the public domain. Use as you see fit. If  
# it breaks, you get to keep all the parts.
# 
# Needs the newer Net::NNTP versions for the MODE READER fix.
# 
# This thing is both faster and uses far less memory than suck. And it  
# inserts a predictable Path: entry (in case the host you pull from  
# doesn't).
# 
# It's in production use as a backup to regular feeds, so it specifically  
# fetches only old articles unless you say -p 1 (default is -p 0.6666...).

use strict;
use Net::NNTP;
use DB_File;
use Data::Dumper;
use Getopt::Std;
use vars qw($Group $Host $Pos $Rc %Rc $Starttime
	    $opt_S $opt_T $opt_d $opt_p $opt_s $opt_t);

my ( @groups, $localhost, $remotehost, $accepted, $rejected, $lockf,
     $history, $acc, $rej, $his, @parms, $from, $to, $art, %err );

$| = 1;

$opt_S = 10;	# sleep between groups
$opt_T = 10000;	# max running time
$opt_d = 0;	# debugging
$opt_p = 2/3;	# how many articles to fetch
$opt_s = 0;	# sleep between articles
$opt_t = 0;	# timeout for NNTP connections
getopts("dt:p:s:S:T:");

die <<USAGE if @ARGV < 2;
Usage: $0 hostname /groups/wanted [ userid password ]
Options:
	-d	debugging
	-t s	NNTP timeout
	-p nn	how many articles (0.0 .. 1.0)
	-s s	sleep between articles
	-S s	sleep between groups
	-T s	max running time
USAGE

my ($GroupsWanted, $userid, $password);
($Host, $GroupsWanted, $userid, $password) = @ARGV;

chdir("/var/local/lib/backupfeed") or die "chdir: $!";
$lockf = "/var/lock/lock-backupfeed-$Host";
system("/usr/lib/news/bin/shlock -p $$ -f $lockf")==0 or exit 0;

open LOG, ">> /var/log/news/backupfeed.$Host" or die "normal log: $!";
autoflush LOG;

open ERR, ">> /var/log/news/backupfeed.$Host.errors" or die "error log: $!";
autoflush ERR;

print LOG scalar(localtime), " $0 starting for $Host\n";
print ERR scalar(localtime), " $0 starting for $Host\n";

open GUP, $GroupsWanted or die "Groups Wanted: $GroupsWanted: $!";
@groups = <GUP>;
close GUP;

$Starttime = time;

$localhost = Net::NNTP->new("localhost", "Debug", $opt_d, "Timeout", $opt_t, "Reader", 0) or die "localhost: $!";

$remotehost = Net::NNTP->new($Host, "Debug", $opt_d, "Timeout", $opt_t) or die "remotehost: $!";
$remotehost->reader;
&lifecheck($remotehost, $Host);
$remotehost->authinfo($userid, $password) if ($userid);
&lifecheck($remotehost, $Host);

tie %Rc, "DB_File", "$Host.bfrc" or die "$Host.bfrc: $!";

$SIG{HUP} = 'IGNORE';
$SIG{INT} = \&sig;
$SIG{TERM} = \&sig;

my $restart = $Rc{'=restart='};
$restart='' unless ($restart);

my @before = grep $_ lt $restart, @groups;
my @after = grep $_ ge $restart, @groups;
@groups = ( @after, @before );

($acc, $rej, $his) = (0, 0, 0);
foreach $Group (@groups) {
	chomp $Group;
	(@parms = $remotehost->group($Group)) or next;
	&lifecheck($remotehost, $Host);
	next if ($#parms < 3);
	$Rc{'=restart='} = $Group;
	print LOG scalar(localtime), " \t<$Group>\n";
	$Rc{$Group} = 0
		if (!defined $Rc{$Group});
	$Rc{$Group} = 0
		if (!$Rc{$Group});
	$from = $parms[1];
	$to = $parms[2];
	$to = $from + ($to - $from) * $opt_p;
	if ($to < $Rc{$Group}) {
		print LOG scalar(localtime), " \t watermark high, reset\n";
		$Rc{$Group} = $from-1;
	}
	$Rc{$Group} = $from-1
		if ($from > $Rc{$Group});
#	print LOG scalar(localtime), " \t\t",$Rc{$Group}+1,"-$to\n";
	$remotehost->nntpstat($Rc{$Group}+1);
#	print LOG scalar(localtime), " \t\t",$remotehost->message,"\n";
	&lifecheck($remotehost, $Host);
	$art = $remotehost->nntpstat;
	&lifecheck($remotehost, $Host);
	$remotehost->message =~ /^(\d+)/;
	$Pos = $1;
	$accepted=0;
	$rejected=0;
	$history=0;
	&offer($art)
		if ($art);
	while ($art = $remotehost->next) {
		&lifecheck($remotehost, $Host);
		$remotehost->message =~ /^(\d+)/;
		$Pos = $1;
		last
			if ($Pos > $to);
		&offer($art);
	}
	&lifecheck($remotehost, $Host);
	print LOG scalar(localtime), " \taccepted=$accepted rejected=$rejected history=$history\n";
	$acc+=$accepted;
	$rej+=$rejected;
	$his+=$history;
	$accepted=0;
	$rejected=0;
	$history=0;
	(tied %Rc)->sync;
	sleep $opt_S if $opt_S;
}

untie %Rc;

$localhost->quit;

$remotehost->quit;

&end0;

sub offer
{
	system("echo $Host $Group $Pos > $Host.status");
	if ($localhost->ihave($_[0])) {
		&lifecheck($localhost, 'localhost');
		my $article = $remotehost->article;
		if (ref $article) {
			#open ART1, "> art1";
			#print ART1 @$article;
			#close ART1;
			my $i = 0;
			while ($i <= @$article && !($$article[$i] =~ /^Path:/i)) {
				$i++;
			}
			$$article[$i] =~ s/^(Path:\s*)/$1NNTP-from-$Host!/i;
			#open ART2, "> art2";
			#print ART2 @$article;
			#close ART2;
			#exit;
			$localhost->datasend($article);
			if ($localhost->dataend) {
				$accepted++;
			}
			else {
				$rejected++;
				$err{" local " . $localhost->code . " " . $localhost->message} ++;
			}
			$Rc{$Group} = $Pos;
			(tied %Rc)->sync;
		}
		else {
				$err{" remote " . $remotehost->code . " " . $remotehost->message} ++;
		}
		sleep $opt_s if $opt_s;
	}
	else {
		if ($localhost->status == 4) {
			if ($localhost->code == 435) {
				$err{" local " . $localhost->code . " " . $localhost->message} ++;
			}
			else {
				$err{" local " . $localhost->code . " " . $localhost->message} ++;
				print LOG scalar(localtime), " local ", $localhost->code, " ", $localhost->message, "\n";
				&end;
			}
		}
		&lifecheck($localhost, 'localhost');
		$history++;
		$Rc{$Group} = $Pos;
	}
}

sub lifecheck
{
	unless (defined $_[0]->code and $_[0]->code > 0) {
		print LOG scalar(localtime), " Connection to $_[1] dropped\n";
		print ERR scalar(localtime), " Connection to $_[1] dropped\n";
		&end;
	}
	#print "time=",time," starttime=$Starttime\n";
	kill 'TERM', $$ if time-$Starttime > $opt_T;
}

sub sig
{
	print LOG scalar(localtime), " Caught sig: ", Data::Dumper::Dumper(@_), "\n";
	print ERR scalar(localtime), " Caught sig: ", Data::Dumper::Dumper(@_), "\n";
	&end;
}

sub end
{
	$acc+=$accepted;
	$rej+=$rejected;
	$his+=$history;
	&end0;
}

sub end0
{
	print LOG scalar(localtime), " $0 $Host accepted=$acc rejected=$rej history=$his\n";
	foreach my $e (sort keys %err) {
		print ERR $err{$e}, $e, "\n";
	}
	print ERR scalar(localtime), " $0 $Host accepted=$acc rejected=$rej history=$his\n";
	close LOG;
	close ERR;
	unlink $lockf;
	exit 0;
}