#!/usr/local/bin/dbzperl
# psl-run - get news from an NNTP server                          -*- perl -*-

# (c) 1994-95 Olaf Titz <olaf.titz@inka.de> and INKA e.V.
# $Id: psl-run,v 2.5 1996/02/23 00:21:38 olaf Exp $

# This program does roughly the same as "slurp" does. The difference
# is the way this one determines which articles to fetch: it takes a
# .newsrc-formatted file (in $workdir/$server/articles) and attempts
# to read all articles with higher numbers than marked in the file,
# just like newsreaders. This saves the huge overhead of the NEWNEWS
# command.

# "psl-run" won't fetch an article if either one of the following
# conditions are met: the article is in the local history file, the
# article's posting date is more than $opt_d days ago, or the
# distribution is "local". These conditions are checked with XHDR
# queries before attempting to read articles.

# "psl-run" builds proper batches into the in.coming directory just
# like nntpd. They can then be processed by "newsrun". (For C News XT,
# just feed them into "rnews".) A batch is ready _iff_ its name
# matches the pattern /^[0-9]+\.t$/. The approximate maximum size of
# the batches is controlled by $opt_b. "psl-run" does its own locking
# via $workdir/$server/LOCK.server files. It does not do any
# interlocking with the news system. If successful, the articles file
# is updated. Failed groups are marked as unsubscribed.

# In order to grok the dbz history file, this needs perl with dbz
# support. Perhaps you need a patch to get this working (see file
# perl.patch). This program does not need any privileges to access the
# news system. It only needs to read the active and history file.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# ----------------------------------------------------------------------------
require "getopts.pl";
require "lockfiles.pl";
require "psl-parm.pl";

# options and defaults
$opt_d = 7;                     # maximum age of articles (0=turn off checking)
$opt_b = 1000000;               # approx. maximum of batch size
# $opt_s                        # don't check space
# $opt_l                        # accept "local"
# $opt_x                        # don't check history, active
# $opt_o                        # don't send MODE READER
# $opt_v                        # log verbosely
# $opt_y                        # generate sendme controls
$opt_t = 20;                    # transfer timeout (minutes)
&Getopts("d:b:slx:ovy:t:");

$server = $ARGV[0]        || die "Usage: $0 <server>";
chdir("$workdir/$server") || die "chdir($workdir/$server) failed";

%daybymonthstr =
    ( "Jan", 0, "Feb", 31, "Mar", 59, "Apr", 90, "May", 120, "Jun", 151,
     "Jul", 181, "Aug", 212, "Sep", 243, "Oct", 273, "Nov", 304, "Dec", 334 );
@monthstr =
    ( "Jan", "Feb", "Mar", "Apr", "May", "Jun",
     "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );

# ----------------------------------------------------------------------------

if (! -s $artfile) {
    exit 0;
}
if (!&lockfile("LOCK.", "server")) {
    if ($?<0) {
        die "$server: Can't establish lock";
    } else {
       exit 0; # no cron mail please
        print STDERR "$server is locked by pid $?\n";
        exit 1;
    }
}

if (!$opt_x) {
    dbmopen(history, $history, 0664) || die "dbmopen($history)";
}
if ($opt_x<3) {
    open(ACT, $active) || die "open($active)";
    while (<ACT>) {
       split;
       $actgroup{$_[0]} = 1;
    }
    close ACT;
}
open(LOG, ">>$logfile")  || die "open($logfile)";
select(LOG); $|=1;

$Sbatch=$Sgread=$Sgfail=$Sgskip=$Saread=$Safail=$Sarej=$Saxpost=$Sbread=0;
$starttime = time;
@_ = localtime; $_[5]+=1900 if ($_[5]<1901);
printf (LOG "\n+++ psl-run %02d.%02d.%04d %02d:%02d\n",
       $_[3], ++$_[4], $_[5], $_[2], $_[1]);
$cutdate = 365*($_[5]-1900) + $_[7] - $opt_d;
$SIG{"HUP"} = "IGNORE";
$SIG{"INT"} = "signal_catch";
$SIG{"TERM"} = "signal_catch";
$SIG{"PIPE"} = "signal_catch";
$SIG{"ALRM"} = "signal_catch";
alarm($opt_t*=60);

socket(NNTP, $AF_INET, $SOCK_STREAM, $IPPROTO_TCP);
($serv,$port) = split(/:/, $server);
$port = $PORT_NNTP unless $port;
@_ = gethostbyname($serv); $? && die "gethostbyname($serv): $?";
if (!connect(NNTP, pack("S n a4 x8", $AF_INET, $port, $_[4]))) {
    print LOG "connect($server) failed: $?\n";
    exit 1;
}
select(NNTP); $|=1;
if (eof(NNTP)) {
    print LOG "connection failed starting up\n";
    exit 1;
}
$_ = <NNTP>; y/\r\n//d;
/^20[01]/
    || die "$server: server failed ($_)";
if (!$opt_o) {
    print NNTP "MODE READER\r\n";
    if (eof(NNTP)) {
       print LOG "connection failed after MODE READER\n";
       exit 1;
    }
    $_ = <NNTP>; y/\r\n//d;
    /^[25]0[01]/
       || die "$server: MODE READER failed ($_)";
}
open(SUB, "<$artfile")   || die "$server: open($artfile)";
open(NSUB, ">$artfile+") || die "$server: open($artfile+)";
select(NSUB); $|=1;

# ----------------------------------------------------------------------------

&open_batch;
while (<SUB>) {
    split; $group = shift(@_);
    $latest = pop(@_); split(/[,-]/,$latest); $latest = pop(@_);
    if ($group =~ /!/) {
       print NSUB;
    } else {
       $group =~ s/://;
       &progress($group);
       alarm($opt_t);
       &nntp_command("GROUP $group");
       if ($status == 211) {
           ($numb, $first, $last) = @resp;
           if (($last>=$latest) && ($first<=$latest)) {
               $first = $latest+1;
           }
           $enumb = $last-$first+1;
           if (($numb>0) && ($enumb>0)) {
               &progress(" $numb/$enumb",
                         "  group $group with $numb articles, $enumb new");
               &process_group;
               print NSUB "$group: 1-$last\n";
               ++$Sgread;
           } else {
               &progress(" 0\n", "  $group empty or no new articles");
               print NSUB "$group: 1-$latest\n";
               ++$Sgskip;
           }
       } else {
           &progress(" -G\n", "  Failed $group (status=$status)");
           print NSUB "$group! 1-$latest\n";
           ++$Sgfail;
       }
    }
}
&finish;
exit 0;

# ----------------------------------------------------------------------------

sub process_group
# $group, $first, $last
{
    undef %dont;
    undef %mid;
    &progress(" H");
    if (($opt_x<3) && ($group =~ /^(control)|(junk)/)) { # special handling
       alarm($opt_t);
       &get_xhdr("Newsgroups") || return 0;
       while ($_=<NNTP>, y/\r\n//d, $_ ne ".") {
           eof(NNTP) && &die_catch("connection");
           ($n,$i) = split(/\s+/, $_, 2);
           $dont{$n} = "j";
           split(/,/, $i);
           while($i=shift(@_)) {
               if ($actgroup{$i}) {
                   undef $dont{$n}; last;
               }
           }
       }
    }
    if ($opt_x<2) {
       alarm($opt_t);
       &get_xhdr("Message-Id") || return 0;
       while ($_=<NNTP>, y/\r\n//d, $_ ne ".") {
           eof(NNTP) && &die_catch("connection");
           split(/\s+/, $_, 2);
           $mid{$_[0]} = $_[1];
           $dont{$_[0]} = "d" if (($opt_x<1) && ($history{$_[1]}));
           if ($gotten{$_[1]}) {
               $dont{$_[0]} = "g"; ++$Saxpost; --$Sarej;
           }
       }
    }
    if ($opt_d) {
       alarm($opt_t);
       &get_xhdr("Date") || return 0;
       while ($_=<NNTP>, y/\r\n//d, $_ ne ".") {
           eof(NNTP) && &die_catch("connection");
           split(/\s+/, $_, 2);
           $date = &parse_date($_[1]);
           $dont{$_[0]} = "o" if ($date < $cutdate);
       }
    }
    if (!$opt_l) {
       alarm($opt_t);
       &get_xhdr("Distribution") || return 0;
       while ($_=<NNTP>, y/\r\n//d, $_ ne ".") {
           eof(NNTP) && &die_catch("connection");
           split(/\s+/, $_, 2);
           $dont{$_[0]} = "l" if ($_[1] eq "local");
       }
    }

    &progress(" A");
    $arttime=time; $artsproc = 0;
    foreach $anr ($first...$last) {
       alarm($opt_t);
       &chprogress;
       if ($dont{$anr}) {
           ++$Sarej;
           # print STDOUT $dont{$anr};
       } else {
           if ($opt_y) {
               if ($mid{$anr}) {
                   $b = 30; # avg msg-id len
                   $gotten{$mid{$anr}} = 1;
                   printf BATCH "%s\n", $mid{$anr};
               } else {
                   ++$Safail;
                   next;
               }
           } else {
               &nntp_command("ARTICLE $anr");
               if ($status==220) {
                   $b = 0;
                   $gotten{$mid{$anr}} = 1;
                   print BATCH "#! rnews           \n"; # 20 chars
                   while ($_=<NNTP>, y/\r//d, $_ ne ".\n") {
                       eof(NNTP) && &die_catch("connection");
                       s/^\.\././;
                       $b += length;
                       print BATCH;
                   }
                   seek(BATCH, -($b+11), $SEEK_CUR) || &die_catch("seek_cur");
                   print BATCH "$b";
                   seek(BATCH, 0, $SEEK_END) || &die_catch("seek_end");
               } else {
                   ++$Safail;
                   next;
               }
           }
           if (($batchsize += $b) > $opt_b) {
               &close_batch; &open_batch;
           }
           ++$artsproc; $Sbread += $b;
       }
    }
    &progress(" $artsproc\n", "    $artsproc articles read.");
    $Spsecs += (time - $arttime);
    $Saread += $artsproc; $artsproc = 0;
}


# ----------------------------------------------------------------------------

sub get_xhdr
{
    local($h) = @_;
    &nntp_command("XHDR $h $first-$last");
    if ($status != 221) {
       &progress("-X$h\n", "    Can't read $h headers");
       return 0;
    }
    &progress(".");
    return 1;
}


# ----------------------------------------------------------------------------

sub parse_date
# return date as number (of days since 1900)
{
    local(@_) = split(/\s+/, $_[0]);
    # convert form: Fri, 09 Sep 1994 08:18:54 -0500
    local($f) = @_[0] =~ /...,?/;
    # standard form: 9 Sep 1994 08:18:31 GMT
    # @_[$f+...]     0 1   2    3        4
    local($y) = @_[$f+2];
    $y -= 1900 if ($y >= 1900);
    return @_[$f] + $daybymonthstr{"@_[$f+1]"} + 365*$y;
}


# ----------------------------------------------------------------------------

sub nntp_command
{
    local($_) = join(" ", @_) . "\r\n";
    print NNTP;
    eof(NNTP) && &die_catch("connection");
    $_ = <NNTP>;
    y/\r//d;
    ($status, @resp) = split;
}

# ----------------------------------------------------------------------------

sub progress
{
    print STDOUT $_[0];
    local($a) = $_[1];
    if ($a) {
       print LOG "$a\n" if ($opt_v || ($a =~ /^\S/)) ;
    }
    $progress = 0;
}

sub chprogress
{
    if ((++$progress) > 50) {
       &progress(".");
    }
}

# ----------------------------------------------------------------------------

sub open_batch
{
    if ($dfcommand && !$opt_s) {
       open(DF, sprintf("$dfcommand|", $inputdir))
           || &die_catch("df");
       $_ = <DF>;
       close DF;
       split;
       if (1024*$_[$dffield] < 2*$opt_b) {
           &die_catch("Filesystem for $inputdir full");
       }
    }
    foreach $i (0..9) {
       ++$batchcount;
       $batchname = sprintf("$inputdir/nntp.%05d%04d", $$, $batchcount);
       if (!-e $batchname) {
           open (BATCH, ">$batchname")
               || &die_catch("open $batchname");
           select BATCH; $|=1;
           if ($opt_y) {
               @_=gmtime; $_[5]+=1900 if ($_[5]<1901);
               print BATCH "Path: psl\nNewsgroups: $opt_y\n";
               print BATCH "Control: sendme $hostname\nSubject: sendme\n";
               print BATCH "From: news@$hostname\n";
               printf BATCH "Message-ID: <sendme-%d.%05d@%s>\n",
                      time, $$, $hostname;
               printf BATCH "Date: %d %s %d %02d:%02d:%02d GMT\n\n",
                      $_[3], $monthstr[$_[4]], $_[5], $_[2], $_[1], $_[0];
           }
           $batchsize = 0;
           return;
       }
    }
    $batchname = "";
    &die_catch("get batchname");
}

sub close_batch
{
    return unless ($batchname);
    close BATCH;
    if ($batchsize) {
       ++$Sbatch;
       foreach $i (0..9) {
           rename($batchname, sprintf("$inputdir/%d.t", time)) && last;
           sleep 10-$i;
       }
    } else {
       unlink $batchname;
    }
    $batchname = "";
}

# ----------------------------------------------------------------------------

sub finish
{
    alarm(0);
    $SIG{"INT"} = "IGNORE";
    $SIG{"TERM"} = "IGNORE";
    $SIG{"PIPE"} = "IGNORE";
    $SIG{"ALRM"} = "IGNORE";
    &close_batch;
    while (<SUB>) { # This will miss the current group (intentionally)
       ++$Sgskip;
       print NSUB;
    }
    close SUB; close NSUB;
    dbmclose(history) unless $opt_x;
    $Saread += $artsproc;
    $Ssecs = time - $starttime;
    ++$Ssecs unless $Ssecs;
    ++$Spsecs unless $Spsecs;
    $Scps = int($Sbread / $Ssecs);
    $Spcps = int($Sbread / $Spsecs);

    if ($opt_y) {
       &progress("${Sgread}g, ${Saread}a, ${Ssecs}s, ${Sbatch} batches\n",
                 "Groups:   read $Sgread, fail $Sgfail, skip $Sgskip\n".
                 "Articles: read $Saread, fail $Safail, reject $Sarej, xpost $
Saxpost\n".
                 "batches $Sbatch, seconds $Ssecs");
    } else {
       &progress("${Sgread}g, ${Saread}a, ${Sbread}b, ${Ssecs}/${Spsecs}s, ".
                 "${Scps}/${Spcps} cps, ${Sbatch} batches\n",
                 "Groups:   read $Sgread, fail $Sgfail, skip $Sgskip\n".
                 "Articles: read $Saread, fail $Safail, reject $Sarej, xpost $
Saxpost\n".
                 "Bytes:    read $Sbread, batches $Sbatch, ".
                 "seconds $Ssecs ($Spsecs), CPS $Scps ($Spcps)");
    }

    close NNTP; close LOG;

    unlink("$artfile.old");
    rename("$artfile", "$artfile.old")
       && rename("$artfile+", "$artfile");
    unlink("LOCK.server");
    exit 0;
}

sub signal_catch
{
    local($s) = @_;
    &progress(" SIG$s\n", "\n$server: Got SIG$s, bailing out");
    &finish;
}

sub die_catch
{
    local($s) = @_;
    &progress("\nF:$s\n", "\n$server: $s failed, bailing out");
    &finish;
}

# ----------------------------------------------------------------------------
