contrib/backupfeed.in

   1 #! /usr/bin/perl -w
   2 #
   3 # Date: 26 Jun 1999 17:59:00 +0200
   4 # From: kaih=7Jbfpa7mw-B@khms.westfalen.de (Kai Henningsen)
   5 # Newsgroups: news.software.nntp
   6 # Message-ID: <7Jbfpa7mw-B@khms.westfalen.de>
   7 # Subject: Re: Version of pullnews that support authentication?
   8 #
   9 # [...]
  10 # I'm appending a script I wrote (called backupfeed.pl for some reason). Hmm
  11 # ... oh, I hereby put that into the public domain. Use as you see fit. If
  12 # it breaks, you get to keep all the parts.
  13 #
  14 # Needs the newer Net::NNTP versions for the MODE READER fix.
  15 #
  16 # This thing is both faster and uses far less memory than suck. And it
  17 # inserts a predictable Path: entry (in case the host you pull from
  18 # doesn't).
  19 #
  20 # It's in production use as a backup to regular feeds, so it specifically
  21 # fetches only old articles unless you say -p 1 (default is -p 0.6666...).
  22
  23 use strict;
  24 use Net::NNTP;
  25 use DB_File;
  26 use Data::Dumper;
  27 use Getopt::Std;
  28 use vars qw($Group $Host $Pos $Rc %Rc $Starttime
  29             $opt_S $opt_T $opt_d $opt_p $opt_s $opt_t);
  30
  31 my ( @groups, $localhost, $remotehost, $accepted, $rejected, $lockf,
  32      $history, $acc, $rej, $his, @parms, $from, $to, $art, %err );
  33
  34 $| = 1;
  35
  36 $opt_S = 10;    # sleep between groups
  37 $opt_T = 10000; # max running time
  38 $opt_d = 0;     # debugging
  39 $opt_p = 2/3;   # how many articles to fetch
  40 $opt_s = 0;     # sleep between articles
  41 $opt_t = 0;     # timeout for NNTP connections
  42 getopts("dt:p:s:S:T:");
  43
  44 die <<USAGE if @ARGV < 2;
  45 Usage: $0 hostname /groups/wanted [ userid password ]
  46 Options:
  47         -d      debugging
  48         -t s    NNTP timeout
  49         -p nn   how many articles (0.0 .. 1.0)
  50         -s s    sleep between articles
  51         -S s    sleep between groups
  52         -T s    max running time
  53 USAGE
  54
  55 my ($GroupsWanted, $userid, $password);
  56 ($Host, $GroupsWanted, $userid, $password) = @ARGV;
  57
  58 chdir("/var/local/lib/backupfeed") or die "chdir: $!";
  59 $lockf = "/var/lock/lock-backupfeed-$Host";
  60 system("/usr/lib/news/bin/shlock -p $$ -f $lockf")==0 or exit 0;
  61
  62 open LOG, ">> /var/log/news/backupfeed.$Host" or die "normal log: $!";
  63 autoflush LOG;
  64
  65 open ERR, ">> /var/log/news/backupfeed.$Host.errors" or die "error log: $!";
  66 autoflush ERR;
  67
  68 print LOG scalar(localtime), " $0 starting for $Host\n";
  69 print ERR scalar(localtime), " $0 starting for $Host\n";
  70
  71 open GUP, $GroupsWanted or die "Groups Wanted: $GroupsWanted: $!";
  72 @groups = <GUP>;
  73 close GUP;
  74
  75 $Starttime = time;
  76
  77 $localhost = Net::NNTP->new("localhost", "Debug", $opt_d, "Timeout", $opt_t, "Reader", 0) or die "localhost: $!";
  78
  79 $remotehost = Net::NNTP->new($Host, "Debug", $opt_d, "Timeout", $opt_t) or die "remotehost: $!";
  80 $remotehost->reader;
  81 &lifecheck($remotehost, $Host);
  82 $remotehost->authinfo($userid, $password) if ($userid);
  83 &lifecheck($remotehost, $Host);
  84
  85 tie %Rc, "DB_File", "$Host.bfrc" or die "$Host.bfrc: $!";
  86
  87 $SIG{HUP} = 'IGNORE';
  88 $SIG{INT} = \&sig;
  89 $SIG{TERM} = \&sig;
  90
  91 my $restart = $Rc{'=restart='};
  92 $restart='' unless ($restart);
  93
  94 my @before = grep $_ lt $restart, @groups;
  95 my @after = grep $_ ge $restart, @groups;
  96 @groups = ( @after, @before );
  97
  98 ($acc, $rej, $his) = (0, 0, 0);
  99 foreach $Group (@groups) {
 100         chomp $Group;
 101         (@parms = $remotehost->group($Group)) or next;
 102         &lifecheck($remotehost, $Host);
 103         next if ($#parms < 3);
 104         $Rc{'=restart='} = $Group;
 105         print LOG scalar(localtime), " \t<$Group>\n";
 106         $Rc{$Group} = 0
 107                 if (!defined $Rc{$Group});
 108         $Rc{$Group} = 0
 109                 if (!$Rc{$Group});
 110         $from = $parms[1];
 111         $to = $parms[2];
 112         $to = $from + ($to - $from) * $opt_p;
 113         if ($to < $Rc{$Group}) {
 114                 print LOG scalar(localtime), " \t watermark high, reset\n";
 115                 $Rc{$Group} = $from-1;
 116         }
 117         $Rc{$Group} = $from-1
 118                 if ($from > $Rc{$Group});
 119 #       print LOG scalar(localtime), " \t\t",$Rc{$Group}+1,"-$to\n";
 120         $remotehost->nntpstat($Rc{$Group}+1);
 121 #       print LOG scalar(localtime), " \t\t",$remotehost->message,"\n";
 122         &lifecheck($remotehost, $Host);
 123         $art = $remotehost->nntpstat;
 124         &lifecheck($remotehost, $Host);
 125         $remotehost->message =~ /^(\d+)/;
 126         $Pos = $1;
 127         $accepted=0;
 128         $rejected=0;
 129         $history=0;
 130         &offer($art)
 131                 if ($art);
 132         while ($art = $remotehost->next) {
 133                 &lifecheck($remotehost, $Host);
 134                 $remotehost->message =~ /^(\d+)/;
 135                 $Pos = $1;
 136                 last
 137                         if ($Pos > $to);
 138                 &offer($art);
 139         }
 140         &lifecheck($remotehost, $Host);
 141         print LOG scalar(localtime), " \taccepted=$accepted rejected=$rejected history=$history\n";
 142         $acc+=$accepted;
 143         $rej+=$rejected;
 144         $his+=$history;
 145         $accepted=0;
 146         $rejected=0;
 147         $history=0;
 148         (tied %Rc)->sync;
 149         sleep $opt_S if $opt_S;
 150 }
 151
 152 untie %Rc;
 153
 154 $localhost->quit;
 155
 156 $remotehost->quit;
 157
 158 &end0;
 159
 160 sub offer
 161 {
 162         system("echo $Host $Group $Pos > $Host.status");
 163         if ($localhost->ihave($_[0])) {
 164                 &lifecheck($localhost, 'localhost');
 165                 my $article = $remotehost->article;
 166                 if (ref $article) {
 167                         #open ART1, "> art1";
 168                         #print ART1 @$article;
 169                         #close ART1;
 170                         my $i = 0;
 171                         while ($i <= @$article && !($$article[$i] =~ /^Path:/i)) {
 172                                 $i++;
 173                         }
 174                         $$article[$i] =~ s/^(Path:\s*)/$1NNTP-from-$Host!/i;
 175                         #open ART2, "> art2";
 176                         #print ART2 @$article;
 177                         #close ART2;
 178                         #exit;
 179                         $localhost->datasend($article);
 180                         if ($localhost->dataend) {
 181                                 $accepted++;
 182                         }
 183                         else {
 184                                 $rejected++;
 185                                 $err{" local " . $localhost->code . " " . $localhost->message} ++;
 186                         }
 187                         $Rc{$Group} = $Pos;
 188                         (tied %Rc)->sync;
 189                 }
 190                 else {
 191                                 $err{" remote " . $remotehost->code . " " . $remotehost->message} ++;
 192                 }
 193                 sleep $opt_s if $opt_s;
 194         }
 195         else {
 196                 if ($localhost->status == 4) {
 197                         if ($localhost->code == 435) {
 198                                 $err{" local " . $localhost->code . " " . $localhost->message} ++;
 199                         }
 200                         else {
 201                                 $err{" local " . $localhost->code . " " . $localhost->message} ++;
 202                                 print LOG scalar(localtime), " local ", $localhost->code, " ", $localhost->message, "\n";
 203                                 &end;
 204                         }
 205                 }
 206                 &lifecheck($localhost, 'localhost');
 207                 $history++;
 208                 $Rc{$Group} = $Pos;
 209         }
 210 }
 211
 212 sub lifecheck
 213 {
 214         unless (defined $_[0]->code and $_[0]->code > 0) {
 215                 print LOG scalar(localtime), " Connection to $_[1] dropped\n";
 216                 print ERR scalar(localtime), " Connection to $_[1] dropped\n";
 217                 &end;
 218         }
 219         #print "time=",time," starttime=$Starttime\n";
 220         kill 'TERM', $$ if time-$Starttime > $opt_T;
 221 }
 222
 223 sub sig
 224 {
 225         print LOG scalar(localtime), " Caught sig: ", Data::Dumper::Dumper(@_), "\n";
 226         print ERR scalar(localtime), " Caught sig: ", Data::Dumper::Dumper(@_), "\n";
 227         &end;
 228 }
 229
 230 sub end
 231 {
 232         $acc+=$accepted;
 233         $rej+=$rejected;
 234         $his+=$history;
 235         &end0;
 236 }
 237
 238 sub end0
 239 {
 240         print LOG scalar(localtime), " $0 $Host accepted=$acc rejected=$rej history=$his\n";
 241         foreach my $e (sort keys %err) {
 242                 print ERR $err{$e}, $e, "\n";
 243         }
 244         print ERR scalar(localtime), " $0 $Host accepted=$acc rejected=$rej history=$his\n";
 245         close LOG;
 246         close ERR;
 247         unlink $lockf;
 248         exit 0;
 249 }