3 # Author: James Brister <brister@vix.com> -- berkeley-unix --
4 # Start Date: Sat, 10 Oct 1998 21:40:11 +0200
7 # RCSId: $Id: pullnews.in 7862 2008-06-08 09:15:41Z iulius $
9 # History: May 2008: Geraint A. Edwards greatly improved pullnews, adding
10 # -b, -C, -d, -G, -H, -k, -l, -m, -M, -n, -P, -Q, -R, -t, -T, -w and
11 # improving -s as well as fixing some bugs.
12 # He also integrated the backupfeed contrib script by Kai Henningsen,
13 # adding -f, -F, -N, -S, -z and -Z to pullnews.
15 # Description: A simple pull feeder. Connects to multiple upstream
16 # machines (in the guise of a reader), and pulls over articles
17 # and feeds them to a downstream server (in the guise of a feeder).
19 # Uses a simple configuration file: $HOME/.pullnews to define
20 # which machines to pull articles from and which groups at each
21 # machine to pull over. There is also support for more specific
22 # configurations like cross-posted newsgroups to kill, thanks to
23 # the -m flag which allows articles with headers matching regexp
26 # A configuration file looks like:
29 # news.software.nntp 0 0
31 # news.uu.net username password
35 # Hostname lines have no leading space and may have an optional
36 # username and password after the hostname; all the
37 # subsequent group lines for that host must have leading
38 # spaces. The two integers on the group line will be updated by
39 # the program when it runs. They are the Unix time the group was
40 # accessed, and the highest numbered article that was pulled
49 $Id: pullnews.in 7862 2008-06-08 09:15:41Z iulius $
52 $SIG{INT} = \&outtaHere;
55 use Net::NNTP 2.18; # With libnet 1.0606 (10-Dec-1998) because older versions
56 # issued MODE READER with Net::NNTP::new().
59 use POSIX qw(ceil floor);
65 my $defaultConfig = "$ENV{HOME}/.pullnews";
66 my $defaultPort = 119;
67 my $defaultHost = "localhost";
68 my $defaultCheckPoint = 0;
69 my $defaultRetries = 0;
71 my $defaultRetryTime = 1;
72 my $defaultProgressWidth = 50;
76 $usage .= " [ -hnqRx -b fraction -c config -C width -d level
77 -f fraction -F fakehop -g groups -G newsgroups -H headers
78 -k checkpt -l logfile -m header_pats -M num -N num
79 -p port -P hop_limit -Q level -r file -s host[:port] -S num
80 -t retries -T seconds -w num -z num -Z num ]
83 -b fraction backtrack on server numbering reset. The proportion
84 (0.0 to 1.0) of a group's articles to pull when the
85 server's article number is less than our high for that
86 group. When fraction is 1.0, pull all the articles on
87 the server. The default is to do nothing.
89 -c config specify the configuration file instead of the
90 default of $ENV{HOME}/.pullnews (also called ~/.pullnews).
92 -C width use width characters for progress (default is $defaultProgressWidth).
94 -d level set debugging level to this integer (default is $defaultDebug).
96 -f fraction proportion of articles to get in each group (0.0 to 1.0).
98 -F fakehop prepend fakehop as a host to the Path: header.
100 -g groups specify a collection of groups to get. The value must be
101 a single argument with commas between group names:
103 -g comp.lang.c,comp.lang.lisp,comp.lang.python
105 The groups must be defined in the config file somewhere.
106 Only the hosts that carry those groups will be contacted.
108 -G newsgroups add these groups to the configuration (see -g and -w).
110 -h print this message.
112 -H headers remove these named headers (colon-separated list).
114 -k checkpt checkpoint the config file every checkpt articles
115 (default is $defaultCheckPoint). A value of 0 means
118 -l logfile log progress/stats to logfile (default is stdout).
120 -m 'Hdr1:regexp1 !Hdr2:regexp2 ...'
121 feed article only if:
122 the Hdr1: header matches regexp1
123 and the Hdr2: header does not match regexp2.
125 -M num maximum number of articles (per group) to process before
128 -n do nothing -- just fake it.
130 -N num timeout length when establishing NNTP connection.
132 -p port specify the port to connect to in order to feed articles
133 (default is $defaultPort).
135 -P hop_limit count hops ('!') in the Path: header, feed article only if:
136 hop_limit is '+num' and hop_count is more than num;
137 or hop_limit is '-num' and hop_count is less than num.
139 -q $0 will normally be verbose about what it is doing. This
140 option will make it quiet.
142 -Q level set the quietness level (-Q 2 is equivalent to -q).
144 -r file rather than feeding to a server, $0 will instead
145 create an rnews-compatible file.
147 -R be a reader (use MODE READER and POST)
150 specify the downstream hostname (and optional port)
151 (default is $defaultHost).
153 -S num specify the maximum time (in seconds) to run.
155 -t retries number of attempts to connect to a server
156 (default is $defaultRetries, see also -T).
158 -T secs time (in seconds) to pause between retries
159 (default is $defaultRetryTime, see also -t).
161 -w num set highwater mark to num (if num is negative, use Current+num
162 instead); a num of 0 will re-get all articles on the server;
163 but a num of -0 will get no old articles, set mark to Current.
165 -x insert an Xref: header in any article that lacks one.
167 -z num time (in seconds) to sleep between articles.
169 -Z num time (in seconds) to sleep between groups.
173 use vars qw($opt_b $opt_c $opt_C $opt_d $opt_f $opt_F $opt_g $opt_G
174 $opt_h $opt_H $opt_k $opt_l $opt_m $opt_M $opt_n
175 $opt_N $opt_p $opt_P $opt_q $opt_Q $opt_r $opt_R $opt_s
176 $opt_S $opt_t $opt_T $opt_w $opt_x $opt_z $opt_Z);
177 getopts("b:c:C:d:f:F:g:G:hH:k:l:m:M:nN:p:P:qQ:r:Rs:S:t:T:w:xz:Z:") || die $usage;
179 die $usage if $opt_h;
181 my @groupsToGet = (); # Empty list means all groups in config file.
182 my @groupsToAdd = ();
184 my $groupFile = $opt_c || $defaultConfig;
185 my $localServer = $opt_s || $defaultHost;
186 my $localPort = $opt_p || $defaultPort;
188 my $watermark = $opt_w;
189 my $retries = $opt_t || $defaultRetries;
190 my $retryTime = $opt_T || $defaultRetryTime;
191 my $checkPoint = $opt_k || $defaultCheckPoint;
192 my $debug = $opt_d || $defaultDebug;
193 my $progressWidth = $opt_C || $defaultProgressWidth;
194 my $maxArts = $opt_M || $defaultMaxArts;
195 my $no_op = $opt_n || 0;
196 my $reader = $opt_R || 0;
197 my $quietness = $opt_Q || 0;
198 my $skip_headers = lc($opt_H) || '';
199 my $logFile = '>&STDOUT';
200 $logFile = ">>$opt_l" if $opt_l;
201 my @hdr_to_match = split(/\s+/, $opt_m) if defined $opt_m;
202 my $pathSteps = $opt_P if defined $opt_P;
205 $localPort = $1 if not defined $opt_p and $localServer =~ s/:(\d+)$//;
207 die "can\'t have both ``-s'' and ``-r''\n" if $opt_s && $opt_r;
209 die "``-b'' value not 0.0-1.0: $opt_b\n" if defined $opt_b and $opt_b !~ /^([01](\.0*)?|0?\.\d+)$/;
210 die "``-C'' value not an integer: $opt_C\n" if $progressWidth !~ m!^\d+$!;
211 die "``-d'' value not an integer: $opt_d\n" if $debug !~ m!^\d+$!;
212 die "``-f'' value not 0.0-1.0: $opt_f\n" if defined $opt_f and $opt_f !~ /^([01](\.0*)?|0?\.\d+)$/;
213 die "``-F'' value not a hostname: $opt_F\n" if defined $opt_f and $opt_f !~ m!^[\w\-\.]+$!;
214 die "``-k'' value not an integer: $opt_k\n" if $checkPoint !~ m!^\d+$!;
215 die "``-M'' value not an integer: $opt_M\n" if defined $maxArts and $maxArts !~ m!^\d+$!;
216 die "``-N'' value not an integer: $opt_N\n" if defined $opt_N and $opt_N !~ /^\d+$/;
217 die "``-p'' value not an integer: $opt_p\n" if $localPort !~ m!^\d+$!;
218 if (defined $pathSteps) {
219 die "``-P'' value not a signed integer: $opt_P\n" if $pathSteps !~ /^[-+](\d+)$/;
222 die "option ``-r -'' needs ``-l'' option\n" if defined $opt_r and $opt_r eq '-' and not $opt_l;
223 die "``-S'' value not an integer: $opt_S\n" if defined $opt_S and $opt_S !~ /^\d+$/;
224 die "``-t'' value not an integer: $opt_t\n" if $retries !~ m!^\d+$!;
225 die "``-w'' value not an integer: $opt_w\n" if defined $watermark and $watermark !~ /^-?\d+$/;
226 die "``-z'' value not an integer: $opt_z\n" if defined $opt_z and $opt_z !~ /^\d+$/;
227 die "``-Z'' value not an integer: $opt_Z\n" if defined $opt_Z and $opt_Z !~ /^\d+$/;
229 $quiet = 1 if $quietness > 1;
231 $NNTP_Args{'Timeout'} = $opt_N if defined $opt_N;
233 @groupsToGet = map { s!^\s*(\S+)\s*!$1!; $_ } split (",", $opt_g) if $opt_g;
234 @groupsToAdd = map { s!^\s*(\S+)\s*!$1!; $_ } split (",", $opt_G) if $opt_G;
254 print "Would write to rnews file $rnews\n";
256 open(RNEWS, ">$rnews") ||
257 die "can't open rnews-format output: $rnews: $!\n";
260 open(LOG, $logFile) || die "can't open logfile ($logFile)!: $!\n";
263 $| = 1; select LOG; $| = 1; select $oldfh;
265 my $lockfile = $ENV{HOME} . "/.pullnews.pid";
266 sysopen (LOCK, "$lockfile", O_RDWR | O_CREAT, 0700) ||
267 die "can't create lock file ($lockfile): $!\n";
268 $oldfh = select; select LOCK; $| = 1; select $oldfh;
270 if (!flock (LOCK, LOCK_EX | LOCK_NB)) {
272 my $otherpid = <LOCK>;
274 die "Another pullnews (pid: $otherpid) seems to be running.\n";
279 print LOG scalar(localtime(time)), " start\n\n" unless $quiet;
281 if (@groupsToGet && ! $quiet) {
282 print LOG "Checking for specific groups:\n";
283 map { printf LOG "\t%s\n", $_ } @groupsToGet;
287 open(FILE, "<$groupFile") || die "can't open group file $groupFile\n";
289 next if m!^\s*\#! || m!^\s*$!;
291 if (m!^(\S+)(\s+(\S+)\s+(\S+))?\s*$!) {
293 $servers->{$sname} = {};
294 $passwd{$sname} = [ $3, $4 ] if defined $3 and $3 ne "";
295 } elsif (m!^\s+(\S+)\s+(\d+)\s+(\d+)!) {
296 my ($group,$date,$high) = ($1,$2,$3);
297 $servers->{$sname}->{$group} = [ $date, $high ];
298 } elsif (m!^\s+(\S+)\s*$!) {
299 # Assume this is a new group.
300 my ($group,$date,$high) = ($1,0,0);
301 print LOG "Looking for new group $group on $sname\n" unless $quiet;
302 $servers->{$sname}->{$group} = [ $date, $high ];
304 die "Fatal error in $groupFile: $.: $_\n";
309 my @servers = (@ARGV || sort keys %$servers);
311 die "No servers!\n" if ! @servers;
316 print LOG "Connecting to downstream host: $localServer " .
317 "port: $localPort ..."
320 my %localopts = ("Port" => "$localPort", "Reader" => $reader, %NNTP_Args);
321 $localcxn = Net::NNTP->new($localServer, %localopts) ||
322 die "Can't connect to server $localServer\n";
325 if ( not $quiet and not $quietness ) {
326 print LOG "done.\n\n";
327 print LOG "Legend: ``.'' is an article the downstream server refused\n";
328 print LOG " ``*'' is an article the downstream server rejected\n";
329 print LOG " ``+'' is an article the downstream server accepted\n";
330 print LOG " ``x'' is an article the upstream server couldn't ";
331 print LOG "give out\n";
332 print LOG " ``m'' is an article skipped due to headers (-m)\n";
334 print LOG "Writing to rnews-format output: $rnews\n\n" if $rnews;
337 foreach my $server (@servers) {
338 my ($username, $passwd);
340 foreach my $addGroup (@groupsToAdd) {
341 next if defined $servers->{$server}->{$addGroup};
342 $servers->{$server}->{$addGroup} = [ 0, 0 ];
345 if (@groupsToGet > 0) {
347 foreach my $sgroup (keys %{$servers->{$server}}) {
348 $ok = 1 if grep($_ eq $sgroup, @groupsToGet);
352 # User gave -g and the server doesn't have those groups.
353 warn "Skipping server $server. Doesn't have specified groups.\n";
358 if (exists $passwd{$server}) {
359 ($username, $passwd) = @{$passwd{$server}};
362 if (!exists($servers->{$server})) {
363 warn "No such upstream host $server configured.\n";
367 my $shash = $servers->{$server};
369 my $connectionAttempts = 0;
372 print LOG "connecting to upstream server $server..." unless $quiet;
373 $upstream = Net::NNTP->new($server, %NNTP_Args);
374 $connectionAttempts++;
375 if (!$upstream && $connectionAttempts <= $retries) {
382 print LOG "failed.\n" unless $quiet;
383 warn "can't connect to upstream server $server: $!\n";
386 print LOG "done.\n" unless $quiet;
389 if ($username && !$upstream->authinfo($username, $passwd)) {
390 warn sprintf ("failed to authorize: %s %s\n",
391 $upstream->code(), $upstream->message());
395 $info{server}->{$server}->{bytes} = 0;
396 $info{server}->{$server}->{fed} = 0;
397 $info{server}->{$server}->{refused} = 0;
398 $info{server}->{$server}->{rejected} = 0;
400 foreach my $group (sort keys %{$servers->{$server}}) {
401 next if (@groupsToGet && !grep ($_ eq $group, @groupsToGet));
403 last if !crossFeedGroup ($upstream,$localcxn,$server,$group,$shash);
404 last if defined $opt_S and time >= $^T+$opt_S;
405 sleep $opt_Z if defined $opt_Z;
409 last if defined $opt_S and time >= $^T+$opt_S;
413 stats() unless $quiet;
416 if (not $no_op and not close RNEWS) {
417 print LOG "\nRNEWS close failure: $!";
419 unlink $rnews if -f $rnews and not -s $rnews;
422 print LOG "\nDone ", scalar(localtime(time)), "\n" unless $quiet;
427 ###############################################################################
435 map { $reftotal += $refused{$_} } keys %refused;
436 map { $rejtotal += $rejected{$_} } keys %rejected;
437 map { $ltotal += $fed{$_} } keys %fed;
439 $sum = $reftotal + $rejtotal + $ltotal;
442 printf LOG localtime() . " [$$] %d article%s to $localServer\n",
443 $sum, ($sum != 1 ? "s" : "");
445 printf LOG "\n%d article%s offered to server on $localServer\n",
446 $sum, ($sum != 1 ? "s were" : " was");
449 return if ($sum == 0);
452 print LOG localtime() . " [$$] $ltotal ok, $reftotal ref, $rejtotal rej\n";
454 printf LOG "%d article%s accepted\n",
455 $ltotal, ($ltotal != 1 ? "s were" : " was")
457 printf LOG "%d article%s refused\n",
458 $reftotal, ($reftotal != 1 ? "s were" : " was")
460 printf LOG "%d article%s rejected\n",
461 $rejtotal, ($rejtotal != 1 ? "s were" : " was")
466 print LOG "\nUpstream server $_:\n" if not $quiet;
471 $width = length if length > $width;
472 } sort keys %{$pulled->{$server}} if not $quiet;
476 printf LOG "%s [$$] from $server $_ %s\n", localtime(), $pulled->{$server}->{$_};
478 printf LOG "\t%${width}s %d\n", $_, $pulled->{$server}->{$_};
480 } sort keys %{$pulled->{$server}};
481 } sort keys %{$pulled};
487 $SIG{INT} = $SIG{QUIT} = 'IGNORE';
489 open(FILE,">$groupFile") || die "can't open $groupFile: $!\n";
493 print LOG "\nSaving config\n" unless $quiet;
494 print FILE "# Format: (date is epoch seconds)\n";
495 print FILE "# hostname [username password]\n";
496 print FILE "# group date high\n";
497 foreach $server (sort keys %$servers) {
498 print FILE "$server";
499 if (defined $passwd{$server}) {
500 printf FILE " %s %s", $passwd{$server}->[0], $passwd{$server}->[1];
503 foreach $group (sort keys %{$servers->{$server}}) {
504 my ($date,$high) = @{$servers->{$server}->{$group}};
505 printf FILE "\t%s %d %d\n",$group,$date,$high;
519 flock (LOCK, LOCK_UN);
520 unlink $lockfile if defined $lockfile;
524 warn "received QUIT signal. Not saving config.\n";
530 my ($fromServer,$toServer,$server,$group,$shash) = @_;
531 my ($date,$high) = @{$shash->{$group}};
532 my ($prevDate,$prevHigh) = @{$shash->{$group}};
533 my ($narticles,$first,$last,$name) = $fromServer->group($group);
536 my $startTime = time;
537 my ($prevRefused, $prevRejected) = ($info{refused}, $info{rejected});
539 if (!defined($narticles)) { # Group command failed.
540 warn sprintf ("Group command failed: %s %s\n",
541 $fromServer->code(), $fromServer->message());
546 printf LOG "\n%s:\n", $name;
547 printf LOG "\tlast checked: %s\n", scalar(localtime($prevDate));
548 printf LOG "\t%d articles available. First %d Last %d\n",
549 $narticles, $first, $last;
551 if (defined $watermark) {
552 printf LOG "\tOur previous highest: %d\n", $prevHigh if not $quiet;
554 $high = $last+$watermark if substr($watermark, 0, 1) eq '-';
555 $high = 0 if $high < 0;
556 $shash->{$group} = [ time, $high ];
558 printf LOG "\tOur current highest: %d", $high if not $quiet;
561 if ($narticles == 0) {
562 print LOG " (nothing to get)\n" unless $quiet;
566 my $toget = (($last - $high) < $narticles ?
567 $last - $high : $narticles);
568 $toget = ceil($toget * $opt_f) if defined $opt_f;
569 if ($last < $high and $opt_b) {
570 $high = $first+floor(($last-$first+1)*(1-$opt_b));
571 $toget = $last - $high;
572 print LOG " (reset highwater mark to $high)" unless $quiet;
573 } elsif ($prevHigh == -1 || $last <= $prevHigh) {
574 # We connected OK but there's nothing there, or we just want
575 # to reset our highwater mark.
576 $shash->{$group} = [ time, $high ];
577 print LOG " (nothing to get)\n" unless $quiet;
580 print LOG " ($toget to get)\n" unless $quiet;
584 for ($i = ($first > $high ? $first : $high + 1) ; $i <= $last ; $i++) {
585 last if defined $maxArts and $count >= $maxArts;
586 last if defined $opt_f and $count >= $toget;
588 sleep $opt_z if defined $opt_z and $count > 1;
589 my $article = $fromServer->article($i);
595 my $len = 0; # Received article length (bytes) (for stats).
596 my $tx_len = 0; # Transmitted article length (bytes) (for rnews).
597 my @header_nums_to_go = ();
598 my $match_all_hdrs = 1; # Assume no headers to match.
599 my $skip_due_to_hdrs = 0;
600 my %m_found_hdrs = ();
603 for ($idx = 0 ; $idx < @{$article} ; $idx++) {
604 $len += length($article->[$idx]);
605 $tx_len += length($article->[$idx]);
606 next if not $headers;
608 $curr_hdr = lc($1) if $article->[$idx] =~ /^([^:[:blank:]]+):/;
609 $curr_hdr = ' ' if $article->[$idx] eq "\n";
611 if ($match_all_hdrs and @hdr_to_match and $article->[$idx] =~ /^[^[:blank:]]/) {
612 # Check header matches -m flag if new header.
614 # Unfold this header (with following lines).
615 my $unfolded_art_hdr = $article->[$idx];
616 for (my $idx_step = $idx+1; $article->[$idx_step] =~ /^[[:space:]](.+)/; $idx_step++) {
617 # While next line is continuation...
619 chomp $unfolded_art_hdr;
620 $unfolded_art_hdr .= $more_line;
623 my ($hdr_un, $val_un) = split(':', $unfolded_art_hdr, 2);
624 $val_un = '' if not defined $val_un;
626 for my $tuple_match (@hdr_to_match) {
627 my ($hdr_m, $val_m) = split(':', $tuple_match, 2);
628 my $negate_h = ($hdr_m =~ s/^!//);
629 next if lc($hdr_un) ne lc($hdr_m);
630 $m_found_hdrs{lc($hdr_m)} = 1;
632 if ($val_un =~ /$val_m/i) {
633 print LOG "\tDEBUGGING $i\t-- $hdr_un [$1]\n" if $debug >= 2;
636 } elsif (not $val_un =~ /$val_m/i) {
637 print LOG "\tDEBUGGING $i\t++ $hdr_un [$1]\n" if $debug >= 2;
640 last if not $match_all_hdrs;
644 if (grep { $curr_hdr eq $_ } split(':', $skip_headers)) {
645 print LOG "\tDEBUGGING $i\tskip_hdr $idx\t$curr_hdr\n" if $debug >= 2;
646 push @header_nums_to_go, $idx;
648 if ($article->[$idx] =~ m!^message-id:\s*(\S+)!i) {
651 if (not $skip_due_to_hdrs and defined $pathSteps and $article->[$idx] =~ m!^Path:\s*!i) {
652 my $path_count = $article->[$idx];
653 $path_count = ($path_count =~ s@!@@g) || 0;
654 if (substr($pathSteps, 0, 1) eq '-') {
655 $skip_due_to_hdrs = 1 if $path_count >= $path_limit;
656 } elsif (substr($pathSteps, 0, 1) eq '+') {
657 $skip_due_to_hdrs = 1 if $path_count <= $path_limit;
659 if ($skip_due_to_hdrs) {
660 print LOG "\tDEBUGGING $i\tNpath_skip_art $i\n" if $debug >= 2;
661 } elsif (defined $opt_F) {
662 $tx_len += length($opt_F)+1;
663 $article->[$idx] =~ s/^Path:\s*/$&$opt_F!/i;
667 if ($opt_x && $article->[$idx] =~ m!^xref:!i) {
671 # Catch some of the more common problems with articles.
672 if ($article->[$idx] =~ m!^\s+\n$! and $curr_hdr ne 'subject') {
673 print STDERR "Fixing bad header line[$idx]-1: $article->[$idx-1]" if $idx > 0;
674 print STDERR "Fixing bad header line[$idx]::: $article->[$idx]";
675 print STDERR "Fixing bad header line[$idx]+1: $article->[$idx+1]";
676 $tx_len -= length($article->[$idx])-1;
677 $article->[$idx] = "\n";
680 $headers = 0 if $article->[$idx] eq "\n";
682 if (@hdr_to_match and (not $match_all_hdrs or @hdr_to_match != scalar(keys %m_found_hdrs))) {
683 print LOG "\tDEBUGGING $i\thdr_skip_art $i\n" if $debug >= 2;
684 $skip_due_to_hdrs = 1;
686 while (@header_nums_to_go) {
687 my $idx = pop @header_nums_to_go; # Start from last.
688 my $cut = join("\n\t", splice(@{$article}, $idx, 1));
689 $tx_len -= length($cut);
690 print LOG "\tDEBUGGING $i\tcut1 $cut" if $debug >= 2;
691 while ($article->[$idx] =~ /^[[:space:]](.+)/) {
693 my $cut = join("\n\t", splice(@{$article}, $idx, 1));
694 $tx_len -= length($cut);
695 print LOG "\tDEBUGGING $i\tcut_ $cut" if $debug >= 2;
700 warn "No Message-ID: header found in article\n";
703 print LOG "\tDEBUGGING $i\tMessage-ID: $msgid\n" if $debug >= 2;
706 # Some old servers lack Xref:, which bothers a downstream INN if
707 # it has xrefslave set, so add one just before the blank line.
708 if ($opt_x && !$xref) {
709 warn "No Xref: header found in article, adding\n";
710 my $xref_h = "Xref: $server $group: $i\n";
711 splice(@{$article}, $idx, 0, $xref_h);
712 $tx_len += length($xref_h);
715 $pulled->{$server}->{$group}++;
716 $info{server}->{$server}->{bytes} += $len;
717 $info{bytes} += $len;
719 if ($skip_due_to_hdrs) {
720 print LOG "m" unless $quiet;
722 printf RNEWS "#! rnews %d\n", $tx_len;
723 map { print RNEWS $_ } @{$article};
724 print LOG "+" unless $quiet;
727 print "Would offer $msgid\n";
729 } elsif ($reader and not $toServer->post($article)) {
730 # 240 article posted ok
731 # 340 send article to be posted. End with <CR-LF>.<CR-LF>
732 # 440 posting not allowed
734 my $code = $toServer->code();
735 my $msg = $toServer->message();
736 print LOG "\tDEBUGGING $i\tPost $code: Msg: <" . join('//', split(/\r?\n/, $msg)) . ">\n" if $debug >= 2;
737 $msg =~ s/^340 .*?\n(?=.)//o;
738 if ($msg =~ /^240 /) {
739 print LOG "+" unless $quiet;
740 push @warns, "Post $i ok ($code): $msg";
742 $info{server}->{$server}->{fed}++;
744 } elsif ($msg =~ /^435 / or $msg =~ /duplicate message-id/io) {
745 print LOG "." unless $quiet;
746 push @warns, "Post $i to server declined ($code): $msg"
747 if $msg !~ /^435 $msgid$/
748 and $msg !~ /duplicate message-id/io;
750 $info{server}->{$server}->{refused}++;
753 warn "Post $i to server failed ($code): $msg\n";
757 } elsif (not $reader and not $toServer->ihave($msgid,$article)) {
758 # 235 article transferred ok
759 # 335 send article to be transferred. End with <CR-LF>.<CR-LF>
760 # 435 article not wanted -- do not send it
761 # 436 transfer failed -- try again later
762 # 437 article rejected -- do not try again
763 my $code = $toServer->code();
764 my $msg = $toServer->message();
765 print LOG "\tDEBUGGING $i\tPost $code: Msg: <" . join('//', split(/\r?\n/, $msg)) . ">\n" if $debug >= 2;
767 print LOG "." unless $quiet;
769 $info{server}->{$server}->{refused}++;
771 } elsif ($code == 437) {
772 print LOG "*" unless $quiet;
774 $info{server}->{$server}->{rejected}++;
777 warn "Transfer to server failed ($code): $msg\n";
784 my $code = $toServer->code();
785 my $msg = $toServer->message();
786 print LOG "\tDEBUGGING $i\tPost $code: Msg: <" . join('//', split(/\r?\n/, $msg)) . ">\n" if $debug >= 2;
787 print LOG "+" unless $quiet;
789 $info{server}->{$server}->{fed}++;
794 $shash->{$group} = [ time, $high = $i ];
796 $shash->{$group} = [ time, $high = $i ] if $fromServer->code() == 430; # no such article, do not retry
797 print LOG "x" unless $quiet;
798 printf LOG ("\nDEBUGGING $i %s %s\n", $fromServer->code(),
799 $fromServer->message()) if $debug >= 2;
801 saveConfig() if $checkPoint and ($count % $checkPoint) == 0;
802 print LOG "\n" if (!$quiet && (($count % $progressWidth) == 0));
803 last if defined $opt_S and time >= $^T+$opt_S;
805 print LOG "\n" unless $quiet;
806 print LOG join("\n\t", '', @warns) . "\n\n" if @warns;
807 my $elapsed_time = time - $startTime + 1;
809 my $rejectedDiff = $info{rejected}-$prevRejected;
810 my $refusedDiff = $info{refused}-$prevRefused;
811 my $destServer = ($localServer ne $defaultHost ? " to $localServer" : '');
812 print LOG localtime() . "[$$] $server$destServer $name $narticles $first-$last : $count $prevHigh-" .
813 ($high == $last ? '' : $high) . " $refusedDiff $rejectedDiff\n"
814 unless $prevHigh == $high and $count == 0;
816 printf LOG "%s article%s retrieved in %d seconds (%d bytes, %d cps)\n",
817 $count, ($count == 1 ? "" : "s"), $elapsed_time,
818 $info{server}->{$server}->{bytes},
819 int($info{server}->{$server}->{bytes}*100/$elapsed_time)/100;