chiark / gitweb /
debugging for thing that crashed
[innduct.git] / frontends / pullnews.in
1 #! /usr/bin/perl -w
2 #
3 # Author:       James Brister <brister@vix.com> -- berkeley-unix --
4 # Start Date:   Sat, 10 Oct 1998 21:40:11 +0200
5 # Project:      INN
6 # File:         pullnews.pl
7 # RCSId:        $Id: pullnews.in 7862 2008-06-08 09:15:41Z iulius $
8 #
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.
14 #
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).
18 #
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
24 #               to be dropped.
25 #
26 #               A configuration file looks like:
27 #
28 #                       data.pa.vix.com 
29 #                               news.software.nntp 0 0
30 #                               comp.lang.c 0 0
31 #                       news.uu.net username password
32 #                               uunet.announce 0 0
33 #                               uunet.help 0 0
34 #
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
41 #               over.
42 #
43
44 require 5.004;
45
46 $0 =~ s!.*/!!;
47
48 my $rcsID =<<'EOM';
49 $Id: pullnews.in 7862 2008-06-08 09:15:41Z iulius $
50 EOM
51
52 $SIG{INT} = \&outtaHere;
53 $SIG{QUIT} = \&bail;
54
55 use Net::NNTP 2.18; # With libnet 1.0606 (10-Dec-1998) because older versions
56                     # issued MODE READER with Net::NNTP::new().
57 use Getopt::Std;
58 use IO::Handle;
59 use POSIX qw(ceil floor);
60 use Fcntl;
61 use Fcntl qw(:flock);
62 use strict;
63
64 my $usage = $0;
65 my $defaultConfig = "$ENV{HOME}/.pullnews";
66 my $defaultPort = 119;
67 my $defaultHost = "localhost";
68 my $defaultCheckPoint = 0;
69 my $defaultRetries = 0;
70 my $defaultDebug = 0;
71 my $defaultRetryTime = 1;
72 my $defaultProgressWidth = 50;
73 my $defaultMaxArts;
74
75 $usage =~ s!.*/!!;
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 ]
81         [ upstream_host ... ]
82
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.
88
89   -c config     specify the configuration file instead of the 
90                 default of $ENV{HOME}/.pullnews (also called ~/.pullnews).
91
92   -C width      use width characters for progress (default is $defaultProgressWidth).
93
94   -d level      set debugging level to this integer (default is $defaultDebug).
95
96   -f fraction   proportion of articles to get in each group (0.0 to 1.0).
97
98   -F fakehop    prepend fakehop as a host to the Path: header.
99
100   -g groups     specify a collection of groups to get.  The value must be 
101                 a single argument with commas between group names:
102
103                         -g comp.lang.c,comp.lang.lisp,comp.lang.python
104
105                 The groups must be defined in the config file somewhere. 
106                 Only the hosts that carry those groups will be contacted.
107
108   -G newsgroups add these groups to the configuration (see -g and -w).
109
110   -h            print this message.
111
112   -H headers    remove these named headers (colon-separated list).
113
114   -k checkpt    checkpoint the config file every checkpt articles
115                 (default is $defaultCheckPoint).  A value of 0 means
116                 normally (at end).
117
118   -l logfile    log progress/stats to logfile (default is stdout).
119
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.
124
125   -M num        maximum number of articles (per group) to process before
126                 bailing out.
127
128   -n            do nothing -- just fake it.
129
130   -N num        timeout length when establishing NNTP connection.
131
132   -p port       specify the port to connect to in order to feed articles
133                 (default is $defaultPort).
134
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.
138
139   -q            $0 will normally be verbose about what it is doing.  This 
140                 option will make it quiet.
141
142   -Q level      set the quietness level (-Q 2 is equivalent to -q).
143
144   -r file       rather than feeding to a server, $0 will instead
145                 create an rnews-compatible file.
146
147   -R            be a reader (use MODE READER and POST)
148
149   -s host[:port]
150                 specify the downstream hostname (and optional port)
151                 (default is $defaultHost).
152
153   -S num        specify the maximum time (in seconds) to run.
154
155   -t retries    number of attempts to connect to a server
156                 (default is $defaultRetries, see also -T).
157
158   -T secs       time (in seconds) to pause between retries
159                 (default is $defaultRetryTime, see also -t).
160
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.
164
165   -x            insert an Xref: header in any article that lacks one.
166
167   -z num        time (in seconds) to sleep between articles.
168
169   -Z num        time (in seconds) to sleep between groups.
170 ";
171
172
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;
178
179 die $usage if $opt_h;
180
181 my @groupsToGet         = ();        # Empty list means all groups in config file.
182 my @groupsToAdd         = ();
183 my $rnews               = $opt_r;
184 my $groupFile           = $opt_c || $defaultConfig;
185 my $localServer         = $opt_s || $defaultHost;
186 my $localPort           = $opt_p || $defaultPort;
187 my $quiet               = $opt_q;
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;
203 my $path_limit;
204
205 $localPort = $1 if not defined $opt_p and $localServer =~ s/:(\d+)$//;
206
207 die "can\'t have both ``-s'' and ``-r''\n"  if $opt_s && $opt_r;
208
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+)$/;
220         $path_limit = $1;
221 }
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+$/;
228
229 $quiet = 1 if $quietness > 1;
230 my %NNTP_Args = ();
231 $NNTP_Args{'Timeout'} = $opt_N if defined $opt_N;
232
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;
235
236 $| = 1;
237
238 my $servers = {};
239 my $sname = undef;
240 my %fed = ();
241 my %refused = ();
242 my %rejected = ();
243 my $pulled = {};
244 my %passwd = ();
245 my %info        = (
246         fed      => 0,
247         refused  => 0,
248         rejected => 0,
249         bytes    => 0,
250 );
251
252 if ($rnews) {
253     if ($no_op) {
254         print "Would write to rnews file $rnews\n";
255     } else {
256         open(RNEWS, ">$rnews") ||
257             die "can't open rnews-format output: $rnews: $!\n";
258     }
259 }
260 open(LOG, $logFile) || die "can't open logfile ($logFile)!: $!\n";
261
262 my $oldfh = select;
263 $| = 1; select LOG; $| = 1; select $oldfh;
264
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;
269
270 if (!flock (LOCK, LOCK_EX | LOCK_NB)) {
271     seek LOCK, 0, 0;
272     my $otherpid = <LOCK>;
273     chomp $otherpid;
274     die "Another pullnews (pid: $otherpid) seems to be running.\n";
275 }
276
277 print LOCK "$$\n";
278
279 print LOG scalar(localtime(time)), " start\n\n" unless $quiet;
280
281 if (@groupsToGet && ! $quiet) {
282     print LOG "Checking for specific groups:\n";
283     map { printf LOG "\t%s\n", $_ } @groupsToGet;
284     print LOG "\n";
285 }
286
287 open(FILE, "<$groupFile") || die "can't open group file $groupFile\n";
288 while (<FILE>) {
289     next if m!^\s*\#! || m!^\s*$!;
290
291     if (m!^(\S+)(\s+(\S+)\s+(\S+))?\s*$!) {
292         $sname = $1;
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 ]; 
303     } else { 
304         die "Fatal error in $groupFile: $.: $_\n";
305     }
306 }
307 close FILE;
308
309 my @servers = (@ARGV || sort keys %$servers);
310
311 die "No servers!\n" if ! @servers;
312
313 my $localcxn;
314
315 if ( not $rnews ) {
316     print LOG "Connecting to downstream host: $localServer " .
317         "port: $localPort ..."
318         unless $quiet;
319
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";
323 }
324
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";
333     print LOG "\n";
334     print LOG "Writing to rnews-format output: $rnews\n\n" if $rnews;
335 }
336
337 foreach my $server (@servers) {
338     my ($username, $passwd);
339
340     foreach my $addGroup (@groupsToAdd) {
341         next if defined $servers->{$server}->{$addGroup};
342         $servers->{$server}->{$addGroup} = [ 0, 0 ];
343     }
344
345     if (@groupsToGet > 0) {
346         my $ok;
347         foreach my $sgroup (keys %{$servers->{$server}}) {
348             $ok = 1 if grep($_ eq $sgroup, @groupsToGet);
349         }
350
351         if (! $ok) {
352             # User gave -g and the server doesn't have those groups.
353             warn "Skipping server $server.  Doesn't have specified groups.\n";
354             next;
355         }
356     }
357
358     if (exists $passwd{$server}) {
359         ($username, $passwd) = @{$passwd{$server}};
360     }
361
362     if (!exists($servers->{$server})) {
363         warn "No such upstream host $server configured.\n";
364         next;
365     }
366
367     my $shash = $servers->{$server};
368
369     my $connectionAttempts = 0;
370     my $upstream;
371     {{
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) {
376             sleep $retryTime;
377             next;
378         }
379     }}
380
381     if (!$upstream) {
382         print LOG "failed.\n" unless $quiet;
383         warn "can't connect to upstream server $server: $!\n";
384         next;
385     } else {
386         print LOG "done.\n" unless $quiet;
387     }
388
389     if ($username && !$upstream->authinfo($username, $passwd)) {
390         warn sprintf ("failed to authorize: %s %s\n",
391                       $upstream->code(), $upstream->message());
392         next;
393     }
394
395     $info{server}->{$server}->{bytes} = 0;
396     $info{server}->{$server}->{fed} = 0;
397     $info{server}->{$server}->{refused} = 0;
398     $info{server}->{$server}->{rejected} = 0;
399
400     foreach my $group (sort keys %{$servers->{$server}}) {
401         next if (@groupsToGet && !grep ($_ eq $group, @groupsToGet));
402
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;
406     }
407
408     $upstream->quit();
409     last if defined $opt_S and time >= $^T+$opt_S;
410 }
411
412 saveConfig ();
413 stats() unless $quiet;
414
415 if ($rnews) {
416     if (not $no_op and not close RNEWS) {
417         print LOG "\nRNEWS close failure: $!";
418     }
419     unlink $rnews if -f $rnews and not -s $rnews;
420 }
421
422 print LOG "\nDone ", scalar(localtime(time)), "\n" unless $quiet;
423
424 cleanLock();
425 exit (0);
426
427 ###############################################################################
428
429 sub stats {
430     my $ltotal = 0;
431     my $reftotal = 0;
432     my $rejtotal = 0;
433     my $sum;
434
435     map { $reftotal += $refused{$_} } keys %refused;
436     map { $rejtotal += $rejected{$_} } keys %rejected;
437     map { $ltotal += $fed{$_} } keys %fed;
438
439     $sum = $reftotal + $rejtotal + $ltotal;
440
441     if ($quiet) {
442         printf LOG localtime() . " [$$] %d article%s to $localServer\n",
443             $sum, ($sum != 1 ? "s" : "");
444     } else {
445         printf LOG "\n%d article%s offered to server on $localServer\n",
446             $sum, ($sum != 1 ? "s were" : " was");
447     }
448
449     return if ($sum == 0);
450
451     if ($quiet) {
452         print LOG localtime() . " [$$] $ltotal ok, $reftotal ref, $rejtotal rej\n";
453     } else {
454         printf LOG "%d article%s accepted\n",
455             $ltotal, ($ltotal != 1 ? "s were" : " was") 
456                 if ($ltotal != 0);
457         printf LOG "%d article%s refused\n",
458             $reftotal, ($reftotal != 1 ? "s were" : " was") 
459                 if ($reftotal != 0);
460         printf LOG "%d article%s rejected\n",
461             $rejtotal, ($rejtotal != 1 ? "s were" : " was") 
462                 if ($rejtotal != 0);
463     }
464
465     map { 
466         print LOG "\nUpstream server $_:\n" if not $quiet; 
467         my $server = $_;
468         my $width = 0;
469
470         map {
471             $width = length if length > $width;
472         } sort keys %{$pulled->{$server}} if not $quiet;
473
474         map { 
475             if ($quiet) {
476                 printf LOG "%s [$$] from $server $_ %s\n", localtime(), $pulled->{$server}->{$_};
477             } else {
478                 printf LOG "\t%${width}s %d\n", $_, $pulled->{$server}->{$_};
479             }
480         } sort keys %{$pulled->{$server}};
481     } sort keys %{$pulled};
482 }
483
484 sub saveConfig {
485     return if $no_op;
486
487     $SIG{INT} = $SIG{QUIT} = 'IGNORE';
488
489     open(FILE,">$groupFile") || die "can't open $groupFile: $!\n";
490     my $server;
491     my $group;
492
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];
501         }
502         print FILE "\n";
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;
506         }
507     }
508     close FILE;
509 }
510
511
512 sub outtaHere {
513     saveConfig();
514     cleanLock();
515     exit (0);
516 }
517
518 sub cleanLock {
519     flock (LOCK, LOCK_UN);
520     unlink $lockfile if defined $lockfile;
521 }
522
523 sub bail {
524     warn "received QUIT signal.  Not saving config.\n";
525     cleanLock();
526     exit (0);
527 }
528
529 sub crossFeedGroup {
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);
534     my $count = 0;
535     my $code;
536     my $startTime = time;
537     my ($prevRefused, $prevRejected) = ($info{refused}, $info{rejected});
538
539     if (!defined($narticles)) { # Group command failed.
540         warn sprintf ("Group command failed: %s %s\n",
541                       $fromServer->code(), $fromServer->message());
542         return undef;
543     }
544
545     if (not $quiet) {
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;
550     }
551     if (defined $watermark) {
552         printf LOG "\tOur previous highest: %d\n", $prevHigh if not $quiet;
553         $high = $watermark;
554         $high = $last+$watermark if substr($watermark, 0, 1) eq '-';
555         $high = 0 if $high < 0;
556         $shash->{$group} = [ time, $high ];
557     }
558     printf LOG "\tOur current highest: %d", $high if not $quiet;
559
560     return 0 if ! $name;
561     if ($narticles == 0) {
562         print LOG " (nothing to get)\n" unless $quiet;
563         return 1;
564     }
565
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;
578         return 1;
579     }
580     print LOG " ($toget to get)\n" unless $quiet;
581
582     my $i;
583     my @warns;
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;
587         $count++;
588         sleep $opt_z if defined $opt_z and $count > 1;
589         my $article = $fromServer->article($i);
590         if ($article) {
591             my $msgid;
592             my $xref = 0;
593             my $headers = 1;
594             my $idx;
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 = ();
601             my $curr_hdr = '';
602
603             for ($idx = 0 ; $idx < @{$article} ; $idx++) {
604                 $len += length($article->[$idx]);
605                 $tx_len += length($article->[$idx]);
606                 next if not $headers;
607
608                 $curr_hdr = lc($1) if $article->[$idx] =~ /^([^:[:blank:]]+):/;
609                 $curr_hdr = '    ' if $article->[$idx] eq "\n";
610
611                 if ($match_all_hdrs and @hdr_to_match and $article->[$idx] =~ /^[^[:blank:]]/) {
612                     # Check header matches -m flag if new header.
613
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...
618                         my $more_line = $1;
619                         chomp $unfolded_art_hdr;
620                         $unfolded_art_hdr .= $more_line;
621                     }
622
623                     my ($hdr_un, $val_un) = split(':', $unfolded_art_hdr, 2);
624                     $val_un = '' if not defined $val_un;
625                     $val_un =~ s/^\s*//;
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;
631                         if ($negate_h) {
632                             if ($val_un =~ /$val_m/i) {
633                                 print LOG "\tDEBUGGING $i\t-- $hdr_un [$1]\n" if $debug >= 2;
634                                 $match_all_hdrs = 0;
635                             }
636                         } elsif (not $val_un =~ /$val_m/i) {
637                             print LOG "\tDEBUGGING $i\t++ $hdr_un [$1]\n" if $debug >= 2;
638                             $match_all_hdrs = 0;
639                         }
640                         last if not $match_all_hdrs;
641                     }
642                 }
643
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;
647                 }
648                 if ($article->[$idx] =~ m!^message-id:\s*(\S+)!i) {
649                     $msgid = $1;
650                 }
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;
658                     }
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;
664                     }
665                 }
666
667                 if ($opt_x && $article->[$idx] =~ m!^xref:!i) {
668                     $xref = 1;
669                 }
670
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";
678                 }
679
680                 $headers = 0 if $article->[$idx] eq "\n";
681             }
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;
685             }
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:]](.+)/) {
692                     # Folded lines.
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;
696                 }
697             }
698
699             if (!$msgid) {
700                 warn "No Message-ID: header found in article\n";
701                 next;
702             } else {
703                 print LOG "\tDEBUGGING $i\tMessage-ID: $msgid\n" if $debug >= 2;
704             }
705
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);
713             }
714
715             $pulled->{$server}->{$group}++;
716             $info{server}->{$server}->{bytes} += $len;
717             $info{bytes} += $len;
718
719             if ($skip_due_to_hdrs) {
720                 print LOG "m" unless $quiet;
721             } elsif ($rnews) {
722                 printf RNEWS "#! rnews %d\n", $tx_len;
723                 map { print RNEWS $_ } @{$article};
724                 print LOG "+" unless $quiet;
725             } else {
726                 if ($no_op) {
727                     print "Would offer $msgid\n";
728
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
733                     #   441 posting failed
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";
741                         $fed{$group}++;
742                         $info{server}->{$server}->{fed}++;
743                         $info{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;
749                         $refused{$group}++;
750                         $info{server}->{$server}->{refused}++;
751                         $info{refused}++;
752                     } else {
753                         warn "Post $i to server failed ($code): $msg\n";
754                         $toServer->quit();
755                     }
756
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;
766                     if ($code == 435) {
767                         print LOG "." unless $quiet;
768                         $refused{$group}++;
769                         $info{server}->{$server}->{refused}++;
770                         $info{refused}++;
771                     } elsif ($code == 437) {
772                         print LOG "*" unless $quiet;
773                         $rejected{$group}++;
774                         $info{server}->{$server}->{rejected}++;
775                         $info{rejected}++;
776                     } else {
777                         warn "Transfer to server failed ($code): $msg\n";
778                         $toServer->quit();
779                         saveConfig();
780                         exit (1);
781                     }
782
783                     } else {
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;
788                     $fed{$group}++;
789                     $info{server}->{$server}->{fed}++;
790                     $info{fed}++;
791                     }
792             }
793
794             $shash->{$group} = [ time, $high = $i ];
795         } else {
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;
800         }
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;
804     }
805     print LOG "\n" unless $quiet;
806     print LOG join("\n\t", '', @warns) . "\n\n" if @warns;
807     my $elapsed_time = time - $startTime + 1;
808     if ($quiet) {
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;
815     } else {
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;
820     }
821     return 1;
822 }