#!/usr/local/bin/perl

# Librement inspiré de rpostarticle.pl :
# http://detebe.org/~news/software/

# Demande un fichier 'filter' (éventuellement) au format de :
#
# s/^NNTP-(.*): /X-Orig-NNTP-$1: /
# d/^X-Trace/
#
# Les s étant un remplacement, et d une supression

use strict;

# Installation dependent stuff (pathnames)
require "/usr/local/news/lib/innshellvars.pl";

my $version="0.1";
my $sm=$inn::pathbin."/sm";
my $logfile=$inn::most_logs."/poster.log";
my $rpost=$inn::pathnews."/contrib/rpost";
my $batchdir=$inn::batch;
my $tmp="/tmp/rpost";
my $artc=0;

my ($storageapi,$batchmode,$modereader,$debug,$port,$server,     $filterfile)=
   (1,          0,         0,          0,     119,  'localhost', '');

my $batchfile;
my $article;

$filterfile=$0;
$filterfile=~s/\/[^\/]+$/\/filter/;

my %filter;

while(@ARGV) {
  my $nextarg=shift;
     if ($nextarg eq '-a') { $storageapi=0; }
  elsif ($nextarg eq '-b') { $batchmode=1; }
  elsif ($nextarg eq '-h') { &usage(); }
  elsif ($nextarg eq '-m') { $modereader=1; }
  elsif ($nextarg eq '-p') { $port=shift; }
  elsif ($nextarg eq '-s') { $server=shift; }
  elsif ($nextarg eq '-d') { $debug=1; }
  elsif ($nextarg eq '-f') { $filterfile=shift; }
  else {
    if ($batchmode) {
      $batchfile=$nextarg;
    } else{
      $article=$nextarg;
    }
  }
}

$batchfile="$batchdir/$batchfile" if($batchmode && ($batchfile!~m!^/!));

open(F,"$filterfile") && do {
  while(<F>) {
    chomp;
    my @f=split(/\//);
    if($f[0] eq 's') {
      $filter{$f[1]}=$f[2];
    } elsif($f[0] eq 'd') {
      $filter{$f[1]}='';
    }
  }
  close(F);
};

if ($debug) {
  print "CMD line args:\n";
  print "--------------\n";
  print "storageapi: $storageapi\n";
  print "modereader: $modereader\n";
  print "batchmode:  $batchmode\n";
  print "batchfile:  $batchfile\n";
  print "article:    $article\n";
  print "server:     $server\n";
  print "port:       $port\n";
  print "filters:    $filterfile (".scalar(keys(%filter)).")\n";
}

if($batchmode) {
  exit(0) unless(-f $batchfile); # nothing to do
  quit("$batchfile.work exists") if (-f "$batchfile.work"); # work in progress or faulty
  rename($batchfile,"$batchfile.work") || quit("Erreur renommage - $batchfile -> $batchfile.work : $!");
  open(B,"$batchfile.work") || quit("Erreur ouverture batch - $batchfile.work : $!");
  while(<B>) {
    chomp;
    my @a=split(/\s+/);
    rpostonearticle($a[0]);
  }
  unlink("$batchfile.work") unless($debug) || quit("Erreur suppression - $batchfile.work : $!");
} else {
  quit("Could not find $article") unless($storageapi || -f $article);
  rpostonearticle($article);
}
exit 0;

sub get_date_short {
  my $t=shift || time;
  my($sec,$min,$hour,$mday,$mon,$year,$wday)=(localtime($t))[0,1,2,3,4,5,6];
  return sprintf("%04d/%02d/%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
}

sub quit {
  my $e=shift;
  print STDERR "$e\n";
  exit(1);
}

sub rpostonearticle {
  my $artid=shift;
  my $rpostflags="";
  my $ok=1;
  my $tf;
  $rpostflags.=" -N $port" if($port!=119);
  $rpostflags.=" -M"       if($modereader);
  open(L,">> $logfile") || quit("Erreur ouverture log - $logfile : $!");
  print L get_date_short." ARTICLE [$artid] TO [$server]\n";
  my $result;
  if($storageapi) {
    open(I,"$sm $artid |") || (($result,$ok)=("Récupération de l'article via sm : $!",0));
  } else {
    open(I,"$artid") || (($result,$ok)=("Récupération de l'article : $!",0));
  }
  if($ok) {
    $artc++;
    $tf=$tmp.".".$$.".".$artc;
    open(O,"> $tf") || (($result,$ok)=("Erreur outfile - $tf : $!",0));
    if($ok) {
      my $h=1;
      while(my $l=<I>) {
        my $d=0;
        $h=0 if($l=~/^[\r\n]+$/);
        if($h) {
          foreach my $f (keys(%filter)) {
            if($filter{$f}) {
              my $f="\$l=~s/$f/$filter{$f}/;";
              eval($f);
            } else {
              if($l=~/$f/) {
                $d=1;
              }
            }
          }
        }
        print O $l unless($d);
      }
    } else {
      close(I);
    }
  }
  if($ok) {
    close(I);
    close(O);
    if($debug) {
      open(R,"/bin/cat $tf |");
    } else {
      open(R,"$rpost $server $rpostflags < $tf |") || (($result,$ok)=("Erreur rpost : $!",0));
    }
    if($ok) {
      while(<R>) {
        $result.=$_;
      }
      close(R);
    }
  }
  unlink($tf) unless($debug);
  print L "$result\n";
  print L "-----------------------------------------------------------------------\n";
  close(L);
}

sub usage
{
  print <<EOU;

$0 v$version

Commandline syntax and semantics:
     [-m] [-a] [-d] -s <server> [-p <port>] <token|path>       OR
  -b [-m] [-a] [-d] -s <server> [-p <port>] <batchfile>

-m (optional) lets rpost issue a "mode reader" first
-a (optional) reads tradspool path instead of storage tokens
-s (optional) tells us what server to post to (localhost by default)
-p (optional) uses a port different from 119
-b (optional) enables batchmode
-d (optional) enables debug mode

<token> or <path> show us the way to the article
<batchfile>       (if "-b") tells us which batch to use
                  (relative to $inn::batch or absolute

EOU

  exit 1;
}