#!/usr/athena/bin/perl
#
# mailpost - yet another mail-to-news filter
#
# kolya 11feb00 return status 111 if server says "currently paused"
# kolya 06jul99 added NNTP posting support
# kolya 10jun99 separated from INN
# brister 19oct98 cleaned up somewhat for perl v. 5. and made a little more
#	robust.
# vixie 29jan95 RCS'd
#	[$Id: mailpost,v 1.6 2002/02/06 18:58:22 kolya Exp $]
# vixie 15jun93 [added -m]
# vixie 30jun92 [added -a and -d]
# vixie 17jun92 [attempt simple-minded fixup to $path]
# vixie 14jun92 [original]

$SendmailPath='/usr/lib/sendmail';
$MaintAddr='usenet-grunge';
$FromHost=`/bin/hostname`;

$NntpServer='localhost';
$NntpPort='119';

use Getopt::Std ;
use IPC::Open3;
use IO::Select;
use Sys::Syslog;
use IO::Socket;

my $debugging = 0 ;
my $msg ;

my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_NB = 4;
my $LOCK_UN = 8;

my $usage = $0 ;
$usage =~ s!.*/!! ;
my $prog = $usage ;

openlog $usage, "pid", "news" ;

$usage .= "[ -r addr ][ -f addr ][ -a approved ][ -d distribution ]" .
    " [ -m mailing-list ][ -b database ][ -o output-path ] newsgroups" ;

use vars qw($opt_r $opt_f $opt_a $opt_d $opt_m $opt_b $opt_n $opt_o $opt_h) ;
getopts("hr:f:a:d:m:b:no:") || die "usage: $usage\n" ;
die "usage: $usage\n" if $opt_h ;

my $Sendmail = $SendmailPath . " -t";
my $Maintainer = $MaintAddr || "usenet" ; 
my $Mailname = $FromHost ;

if ($debugging || $opt_n) {
    $Sendmail = "cat" ;
    $WhereTo = "cat" ;
}

chop ($Mailname = `/bin/hostname`) if ! $Mailname ;


#
# our command-line argument(s) are the list of newsgroups to post to.
#
# there may be a "-r sender" or "-f sender" which becomes the $path
# (which is in turn overridden below by various optional headers.)
#
# -d (distribution) and -a (approved) are also supported to supply
# or override the mail headers by those names.
#

my $path = 'mailpost-gateway';
my $newsgroups = undef;
my $approved = undef;
my $distribution = undef;
my $mailing_list = undef;
my $references = undef;

if ($opt_r || $opt_f) {
    $path = $opt_r || $opt_f ;
}

if ($opt_a) {
    $approved = &fix_sender_addr($opt_a);
}

if ($opt_d) {
    $distribution = $opt_d ;
}

if ($opt_m) {
    $mailing_list = "<" . $opt_m . "> /dev/null";
}

$newsgroups = join ", ", @ARGV ;

die "usage:  $0 newsgroup [newsgroup]\n" unless $newsgroups;


#
# do the header.  our input is a mail message, with or without the From_
#

#$default_message_id = sprintf("<mailpost.%d.%d@%s>", time, $$, $Hostname);
my $real_news_hdrs = '';
my $weird_mail_hdrs = '';
my $fromHdr = "MAILPOST-UNKNOWN-FROM" ;
my $dateHdr= "MAILPOST-UNKNOWN-DATE" ;
my $msgIdHdr = "MAILPOST-UNKNOWN-MESSAGE-ID" ;
my $from = undef;
my $date = undef;
my $hdr = undef;
my $txt = undef;
my $message_id ;
my $subject = "(NONE)";

$_ = <STDIN>;
if (!$_) {
    if ( $debugging || -t STDERR ) {
	die "empty input" ;
    } else {
	syslog "err", "empty input" ;
	exit (0) ;
    }
}

chomp $_;

my $line = undef;
if (/^From\s+([^\s]+)\s+/) {
    $path = $1;
    $_ = $';
    if (/ remote from /) {
	$path = $' . '!' . $path;
	$_ = $`;
    }
    $date = $_;
} else {
    $line = $_;
}

$in_header=1;
for(;;) {

    if($in_header) {
    	$_ = <STDIN>;
    	s/[\r\n]*$//;
	if(/^$/) { $in_header=0; }
    }

    # gather up a single header with possible continuation lines into $line
    if (/^\s+/) {
	if (! $line) {
	    $msg = "First line with leading whitespace!" ;
	    syslog "err", $msg unless -t STDERR ;
	    die "$msg\n" ;
	}	    

	$line .= "\n" . $_ ;
	next ;
    }

    # On the first header $line will be undefined.
    ($_, $line) = ($line, $_) ; # swap $line and $_ ;

    last if defined($_) && /^$/;
    next if /^$/;

    next if /^Approved:\s/sio && defined($approved);
    next if /^Distribution:\s/sio && defined($distribution);

    if (/^(Organization|Distribution):\s*/sio) {
	$real_news_hdrs .= "$_\r\n";
	next;
    }

    if (/^Subject:\s*/sio) {
	$subject = $';
	next;
    }

    if (/^Message-ID:\s*/sio) {
	$message_id = $';
	next;
    }

    if (/^Mailing-List:\s*/sio) {
	$mailing_list = $';
	next;
    }

    if (/^(Sender|Approved):\s*/sio) {
	$real_news_hdrs .= "$&" . fix_sender_addr($') . "\r\n";
	next;
    }

    if (/^Return-Path:\s*/sio) {
	$path = $';
	$path = $1 if ($path =~ /\<([^\>]*)\>/);
	next;
    }

    if (/^Date:\s*/sio) {
	$date = $';
	next;
    }

    if (/^From:\s*/sio) {
	$from = &fix_sender_addr($');
	next;
    }

    if (/^References:\s*/sio) {
	$references = $';
	next;
    }

    if (!defined($references) && /^In-Reply-To:[^\<]*\<([^\>]+)\>/sio) {
	$references = "<$1>";
	# FALLTHROUGH
    }

    if (/^(MIME|Content)-[^:]+:\s*/sio) {
	$real_news_hdrs .= $_ . "\r\n";
	next ;
    }

    # random unknown header.  prepend 'X-' if it's not already there.
    #$_ = "X-$_" unless /^X-/sio ;
    #$weird_mail_hdrs .= "$_\n";
}

$msgIdHdr = $message_id if $message_id; # || $default_message_id ;
$fromHdr = $from if $from ;
$dateHdr = $date if $date ;

if ($path !~ /\!/) {
    $path = "$'!$`" if ($path =~ /\@/);
}

$real_news_hdrs .= "Subject: ${subject}\r\n";
$real_news_hdrs .= "Message-ID: ${msgIdHdr}\r\n";
$real_news_hdrs .= "Mailing-List: ${mailing_list}\r\n" if defined($mailing_list);
$real_news_hdrs .= "Distribution: ${distribution}\r\n" if defined($distribution);
$real_news_hdrs .= "Approved: ${approved}\r\n"         if defined($approved);
$real_news_hdrs .= "References: ${references}\r\n"     if defined($references);

$article =
	"Path: ${path}\r\n".
	"From: ${fromHdr}\r\n".
	"Newsgroups: ${newsgroups}\r\n".
	"${real_news_hdrs}Date: ${dateHdr}\r\n".
	"${weird_mail_hdrs}\r\n".
	"\r\n";

while(<STDIN>) {
 s/[\r\n]*$//;
 if(/^\./) {
  $article .= ".";
 }
 $article .= $_. "\r\n";
}

##
## We've got the article in $article and now we validate some of the
## data we found
##

mailArtAndDie (0, "no From: found") unless $from;
mailArtAndDie (0, "no Date: found") unless $date;
mailArtAndDie (0, "no Message-ID: found") unless $message_id;
mailArtAndDie (0, "Malformed message ID ($message_id)") 
    if ($message_id !~ /\<(\S+)\@(\S+)\>/);

my ($lhs, $rhs) = ($1, $2);	# of message_id match above.

$message_id = "<${lhs}\@${rhs}>";

# Attempt to connect; bail out with non-zero exit status if server
# unreachable -- try to retransmit later.
$socket=IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>$NntpServer,
	PeerPort=>$NntpPort, Reuse=>1) or
	mailArtAndDie(1, "cannot connect to $NntpServer\:$NntpPort");
$socket->autoflush(1);

$state=0;

while(<$socket>) {
 s/[\r\n]*$//;
 # state 0 - just connected, no data yet
 if($state == 0) {
  if(/^200/) {
   print $socket "ihave $message_id\r\n";
   $state=1;
  } else {
   print $socket "quit\r\n";
   close($socket);
   if(/currently paused/) {
     $failure_status = 111;
   } else {
     $failure_status = 1;
   }
   &mailArtAndDie($failure_status, "news server said $_");
  }
 }
 # state 1 - sent ihave $msgid
 elsif($state == 1) {
  if(/^335/) {
   # 335 send article to be transferred.  End with <CR-LF>.<CR-LF>
   print $socket $article, ".\r\n";
   $state=2;
  }
  elsif(/^435/) {
   # 435 article not wanted - do not send it
   print $socket "quit\r\n";
   close($socket);
   exit(0);
  } else {
   print $socket "quit\r\n";
   close($socket);
   &mailArtAndDie(1, "server replied to inews: $_");
  }
 }
 # state 2 - article sent
 elsif($state == 2) {
  if(/^(235|437)/) {
   # 235 article transferred ok
   # 437 article rejected - do not try again
   print $socket "quit\r\n";
   close($socket);
   exit(0);
  } else {
   print $socket "quit\r\n";
   close($socket);
   &mailArtAndDie(1, "server replied to article: $_");
  }
 }
}

sub mailArtAndDie {
    my ($exit_status, $msg) = @_ ;
    
    print STDERR $msg,"\n" if -t STDERR ;

    # Only send mail if the error is fatal (error codes 0 or 1).
    # There are also transient failures, error code 111.
    if (($exit_status == 1) || ($exit_status == 0)) {
	open SENDMAIL, "|" . sprintf ($Sendmail,$Maintainer) ||
	    die "die($msg): sendmail: $!\n" ;
	print SENDMAIL <<"EOF" ;
To: $Maintainer
Subject: mailpost failure ($newsgroups): $msg
     
$msg
EOF
     
	if ($article) {
	    print SENDMAIL
		    "\n-------- Article Contents\n\n",
		    $article;
	} else {
	    print "No article left to send back.\n" ;
	}
	close SENDMAIL ;
    }
    
    exit($exit_status);
}

#
# take 822-format name (either "comment <addr> comment" or "addr (comment)")
# and return in always-qualified 974-format ("addr (comment)").
#
sub fix_sender_addr {
    my ($address) = @_;
    my ($lcomment, $addr, $rcomment, $comment);
    local ($',$`,$_) ;

    if ($address =~ /\<([^\>]*)\>/) {
	($lcomment, $addr, $rcomment) = (&dltb($`), &dltb($1), &dltb($'));
    } elsif ($address =~ /\(([^\)]*)\)/) {
	($lcomment, $addr, $rcomment) = ('', &dltb($`.$'), &dltb($1));
    } else {
	($lcomment, $addr, $rcomment) = ('', &dltb($address), '');
    }
    
    #print STDERR "fix_sender_addr($address) == ($lcomment, $addr, $rcomment)\n";
    
    $addr .= "\@$Mailname" unless ($addr =~ /\@/);
    
    if ($lcomment && $rcomment) {
	$comment = $lcomment . ' ' . $rcomment;
    } else {
	$comment = $lcomment . $rcomment;
    }
    
    $_ = $addr;
    $_ .= " ($comment)" if $comment;
    
    #print STDERR "\t-> $_\n";
    
    return $_;
}

#
# delete leading and trailing blanks
#

sub dltb {
    my ($str) = @_;
    
    $str =~ s/^\s+//o;
    $str =~ s/\s+$//o;
    
    return $str;
}