+++ /dev/null
-#! /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;
-}