#!/usr/bin/perl -T
# Owner: news
# Group: news

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

# Written for the Debian distribution with INN 2.3.2;
# may need some changes to work somewhere else!

use strict;
use IO::Handle;
use Term::ReadKey;
use Fcntl qw(:DEFAULT :flock);

my ($proc) = '$Id: rpnews 43983 2011-05-27 11:17:29Z vinc17/ay $'
  =~ /^.Id: (\S+) / or die;

$< or die "Do not run $proc as root!\n";

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

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

my $news = '/var/spool/news';
my $lock = "$news/rpnews.lock";

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

chomp(my $SecWarning = <<'EOF');
  WARNING! The -P option is not secure if there are other users
  of the machine! You should use the -A option instead.
EOF

my $Usage = <<EOF;
Usage: $proc [ -a | -p | -r ] [ -A ] [ -U userid ] [ -P passwd ] [ server ]
  -a  post and read
  -p  post only
  -r  read only
  -A  authentication by newsauth passed to the standard input

$SecWarning
EOF

my ($newsauth,$userid,$passwd,$opt,$ispn,$v);
my $hostrx = qr/[a-z][-a-z0-9.]*/;
foreach (@ARGV)
  {
    $v eq 'U' and $userid = $_, $v = '', next;
    $v eq 'P' and $passwd = $_, $v = '', warn(<<EOF), next;
==================================================================
$SecWarning
==================================================================
EOF
    /^-A$/ and $newsauth = 1, next;
    /^-([UP])$/ and $v = $1, next;
    /^-([apr])$/ and $opt = $1, next;
    defined $ispn and die $Usage;
    ($ispn) = /^($hostrx)$/ or die $Usage;
  }
$v eq '' or die $Usage;

$ispn ne ''
  or ($ispn) = $ENV{'ISP_NNTPSERVER'} =~ /^($hostrx)$/
  or die "Environment variable ISP_NNTPSERVER is not correctly set!\n";
my $host = $ENV{'NNTP_PROXY'} =~ /^($hostrx(:\d+)?)$/ ? $1 : $ispn;

my $suffix = time.".$$";
my $outgoing = "$news/outgoing";
my $oldout = "$outgoing/$ispn";
my $newout = "$oldout.$suffix";
my $ffile = "/tmp/filter.$suffix";
my $fart = "/tmp/article.$suffix";

if ($newsauth)
  {
    while (<STDIN>)
      { /^\Q$ispn\E\s+(\S+)\s+(\S+)\s*$/ and ($userid,$passwd) = ($2,$1) }
  }

my @id;
if (defined $userid)
  {
    unless (defined $passwd)
      {
        open TTY, ">/dev/tty" or die "$proc: can't open /dev/tty\n$!\n";
        TTY->autoflush(1);
        print TTY "Password: ";
        ReadMode 'noecho';
        $passwd = ReadLine 0;
        ReadMode 'restore';
        print TTY "\n";
        close TTY;
      }
    # @id = ('-U', $userid, '-P', $passwd);  # This method wasn't secure.
    $ENV{'NNTP_USER'} = $userid;
    $ENV{'NNTP_PASS'} = $passwd;
    @id = ('-Q');
  }

my $bold = -t STDOUT ? `tput bold` : '';
my $sgr0 = -t STDOUT ? `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 (!-e $oldout)
      {
        &pr("No outgoing file");
      }
    elsif (link $oldout, $newout)
      {
        unlink $oldout
          or die "$proc: can't unlink $oldout\n$!\n";
        &pr("Flushing the $ispn buffer...");
        system 'ctlinnd', 'flush', $ispn and &pr("ctlinnd failed!");
      }
    else
      {
        die "$proc: can't link $oldout to $newout\n$!\n";
        # or a race condition...
      }

    &pr("Posting the articles...");
    my $p;
    opendir DIR, $outgoing
      or die "$proc: 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 "$proc: can't read/stat $file\n";
        if ($s[7])
          {
            &filter;
            &pr("Calling rpost on \"$file\"...");
            system 'rpost', $host, @id, '-b', $file, '-d', '-f', $ffile,
              '$$o='.$fart, '$$i', $fart and &pr("rpost failed!");
            unlink $ffile, $fart;
            $p = 1;
          }
        else
          { unlink $file or die "$proc: 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 "$proc: can't cd to /etc/suck\n$!\n";
    -e $batch and die "$proc: file $batch already exists\n";
    system 'suck', $host, @id, '-c', '-n', '-p', ".$ispn",
      '-HI', '-br', $batch;
    -e $batch or return;
    system 'rnews', $batch or unlink $batch;
  }

sub filter
  {
    open FILTER, ">$ffile" or die "$proc: can't create filter file\n";
    -o $ffile && -f _
      or die "$proc: $ffile is not a plain file owned by ".getpwuid($>)."!\n";
    print FILTER <<'EOF';
#!/usr/bin/perl -T
use strict;
$ENV{'PATH'} = '/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin';
my ($i) = $ARGV[0] =~ m:^(@\S+@)$: or die;
my ($o) = $ARGV[1] =~ m:^(/tmp/\S+)$: or die;
unlink $o;
open IN, "/usr/lib/news/bin/sm $i |" or warn("Can't exec sm $i\n"), exit;
open OUT, ">$o" or die "$!";
my $a;
my $h = 1;
while (<IN>)
  {
    $a = 1;
    $_ 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 "$!";
$a or unlink $o;
EOF
    close FILTER or die "$proc: can't close filter file\n";
    chmod 0755, $ffile;
  }

unlink $lock or die "$proc: can't remove lock file\n$!\n";

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