chiark / gitweb /
xfoo => mfoo, rename
[innduct.git] / 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 }