#!/usr/local/bin/perl -T

# Note: this script must be setuid and setgid news.
# "chown -R news: /etc/suck" required.

use strict;

$< = $>;  # set real to effective uid

use Fcntl qw(:DEFAULT :flock);

$ENV{'NNTPSERVER'} =~ /^(localhost)?$/
  or die "Environment variable NNTPSERVER refers to a distant server!\n";

my ($ispn) = $ENV{'ISP_NNTPSERVER'} =~ /^([a-z][a-z0-9.]*)$/;
$ispn eq '' and die "Environment variable ISP_NNTPSERVER is unset!\n";

my $filter = 1;  # Set this to 0 to suppress the filter
my $news = '/var/spool/news';
my $suffix = time.".$$";
my $prefix = "$news/articles";
my $outgoing = "$news/outgoing";
my $oldout = "$outgoing/$ispn";
my $newout = "$oldout.$suffix";
my $ffile = "/tmp/filter.$suffix";
my $fart = "/tmp/article.$suffix";
my $lock = "$news/rpnews.lock";

my $Usage = <<'EOF';
Usage: rpnews [ -a | -p | -r ] [ -U userid ] [ -P passwd ]
  -a  post and read
  -p  post only
  -r  read only
EOF

open LOCK, ">$lock" or die "rpnews: can't create lock file\n$!\n";
flock LOCK, LOCK_EX | LOCK_NB or die "rpnews: already running\n$!\n";

$ENV{'PATH'} = '/usr/local/bin:/bin:/usr/bin';

my ($userid,$passwd,$opt,$v);
foreach (@ARGV)
  {
    $v eq 'U' and $userid = $_, $v = '', next;
    $v eq 'P' and $passwd = $_, $v = '', next;
    /^-([UP])$/ and $v = $1, next;
    ($opt) = /^-([apr])$/ or die $Usage;
  }
$v eq '' or die $Usage;

my @id;
defined $userid && defined $passwd and @id = ('-U', $userid, '-P', $passwd);

my $bold = `tput bold`;
my $sgr0 = `tput sgr0`;

&pr("Sending spooled messages to the server (if running)...");
system 'rnews', '-U';

&postnews unless $opt eq 'r';
&readnews unless $opt eq 'p';

sub postnews
  {
    &pr("Renaming outgoing file \"$ispn\"...");
    if (link $oldout, $newout)
      {
        unlink $oldout
          or die "rpnews: can't unlink $oldout\n$!\n";
        &pr("Flushing the $ispn buffer...");
        system 'ctlinnd', 'flush', $ispn and &pr("ctlinnd failed!");
      }
    elsif (-e $oldout)
      {
        die "rpnews: can't link $oldout to $newout\n$!\n";
        # or a race condition...
      }
    else
      {
        &pr("No outgoing file");
      }

    &pr("Posting the articles...");
    my $p;
    opendir DIR, $outgoing
      or die "rpnews: can't open directory $outgoing\n$!\n";
    my @d = readdir DIR;
    closedir DIR;
    foreach (@d)
      {
        /^(\Q$ispn\E\.\d+\.\d+)$/ or next;
        my $file = "$outgoing/$1";
        -r $file and my @s = stat $file
          or die "rpnews: can't read/stat $file\n";
        if ($s[7])
          {
            my @arg = $filter ? &filter : ();
            &pr("Calling rpost on \"$file\"...");
            system 'rpost', $ispn, @id, '-b', $file, '-p', $prefix, '-d', @arg
              and &pr("rpost failed!");
            $filter and unlink $ffile, $fart;
            $p = 1;
          }
        else
          { unlink $file or die "rpnews: can't unlink $file\n$!\n"; }
      }
    $p or &pr("No articles to post");
  }

sub readnews
  {
    &pr("Receiving the articles...");
    my $batch = "batch.$suffix";
    chdir '/etc/suck' or die "rpnews: can't cd to /etc/suck\n$!\n";
    -e $batch and die "rpnews: file $batch already exists\n";
    my $u = -e 'sucknewsrc';
    my $file = "sucknewsrc.$ispn";
    unless ($u)
      {
        -e $file or die "rpnews: no sucknewsrc file\n";
        link $file, 'sucknewsrc'
          or die "rpnews: can't link $file to sucknewsrc\n$!\n";
      }
    system 'suck', $ispn, @id, '-c', '-n', '-HF', '/var/lib/news/history',
      '-br', $batch;
    unless ($u)
      {
        unlink $file
          or die "rpnews: can't unlink $file\n$!\n";
        link 'sucknewsrc', $file
          or die "rpnews: can't link sucknewsrc to $file\n$!\n";
        unlink 'sucknewsrc'
          or die "rpnews: can't unlink sucknewsrc\n$!\n";
      }
    system 'rnews', $batch or unlink $batch;
  }

sub filter
  {
    open FILTER, ">$ffile" or die "rpnews: can't create filter file\n";
    print FILTER <<'EOF';
#!/usr/local/bin/perl -T
use strict;
my ($i) = $ARGV[0] =~ m:^(/var/spool/news/\S+)$: or die;
my ($o) = $ARGV[1] =~ m:^(/tmp/\S+)$: or die;
unlink $o;
open IN, "<$i"
  or warn("Can't open file $i: $!\nHas article been canceled?\n"), exit;
open OUT, ">$o" or die "$!";
my $h = 1;
while (<IN>)
  {
    $_ eq "\n" and undef $h;
    print OUT unless $h && /^(NNTP-Posting-\S+|X-Complaints-To|X-Trace|Xref):/i
  }
close OUT or die "$!";
close IN or die "$!";
EOF
    close FILTER or die "rpnews: can't close filter file\n";
    chmod 0755, $ffile;
    return ('-f', $ffile, '$$o='.$fart, '$$i', $fart);
  }

flock LOCK, LOCK_UN | LOCK_NB or warn "rpnews: flock failed (unlock)\n$!\n";
close LOCK or warn "rpnews: can't close lock file\n$!\n";
unlink $lock or die "rpnews: can't remove lock file\n$!\n";

sub pr
  { print "$bold@_$sgr0\n"; }

# $Id: rpnews 2.8 2001/09/12 00:31:01 lefevre Exp $