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 }