#!/usr/bin/perl -w
#######################################################################
#
#   Mail to news script.
#
#   Allows posting from an e-mail address to a Usenet newsgroup.
#   This script is MIME-compliant, so that posting HTML or multi-part
#   e-mails should be OK.
#   This was designed for a site running INN version 2.x on a 
#   Linux CentOS 4.3 platform. Your mileage may vary.
#   Please check the variables below to customise to your local
#   configuration.
#
#   Syntax: pathto/mail2news.pl newsgroup_name list-tag.
#
#   The list-tag is an optional command line argument which will
#   remove those [My list name] from the Subject line.
#   Do not add the brackets to the command line argument as 
#   brackets have a special meaning in Perl regexes.
#
#   In Sendmail aliases, for each newsgroup, add a line saying
#   newsgroup-name: "|pathto/mail2news.pl newsgroup.name  list-tag"
#
#   If the list tag includes a space, you should place list-tag 
#   between quotes.
#
#   Please remember to add a symlink to mail2news.pl in /etc/smrsh/
#
#   Author: Patrick Vande Walle  <patrick@isoc.lu>
#
#   This script is put in the public domain. 
#
#   Based on prior work from the mail2news mini-HOWTO
#   and by Vivek Khera: 
#   http://cpan.org/authors/id/V/VK/VKHERA/mail2news-1.14
#
#   23 Mar 2006: added an option to strip list tag names. 
#
#   22 Mar 2006: added a "Distribution: local" headers. 
#	         which prohibits propagation to upstreams
#
#   16 Jun 2006: added some additional headers to pass   
#
#   TODO:
#
#####################################################################
use strict;

# $Id: mail2news,v 1.0.1 2006/06/16 09:00:00 patrickv Exp $
require 5.005;

use Mail::Header;
use vars qw($VERSION $sec $min $hour $mday $mon $year $madeupid $tagline $LocalSubject);

####################################################
# change this to point to your local configuration.
my $news_poster_program = "/usr/lib/news/bin/rnews";
my $postinghost = "news.isoc.lu";
my $news_poster_options = "-r news.isoc.lu";
my $gatewayname = "usenet\@$postinghost";
####################################################

####################################################
# Other variables - Do not touch
my $program = $0 ;
$VERSION = do { my @r=(q$Revision: 1.0.1 $ =~ /\d+/g); sprintf '%d.'.'%02d' x $#r, @r };
####################################################

# Check for newsgroup on command line
my $newsgroup = (shift || die "No newsgroup specified.\n");

# Check for tagline on command line
my $tagline = (shift || "" );

# process headers
my $head = (new Mail::Header \*STDIN || die "Mail::Header failure.\n");

# make sure a subject line is there, and has contents!
if ($head->count('Subject') == 0) {
  $head->add('Subject','(No subject)');
} elsif ($head->get('Subject') =~ m/^\s*$/) {
  $head->replace('Subject','(No subject)');
}

# If necessary, delete the mailing list tag line mentioned as a command-line parameter
if ($tagline ne ""){ 
    $LocalSubject=($head->get('Subject')); 
    $tagline=~ s/\[//;  	          # If brackets were mentioned on the command line, remove them.
    $tagline=~ s/\]//;           	  # If brackets were mentioned on the command line, remove them.
    $LocalSubject=~ s/\[$tagline\]\s+//i; # Remove the tagline and the space following it.
    $LocalSubject=~ s/^\s+//;     	  # Trim leading white space, if any.
    $head->replace('Subject',$LocalSubject);
    }

# If there is no Message-ID, create one.
if ($head->count('Message-ID') == 0) {
   ($sec,$min,$hour,$mday,$mon,$year)=localtime(time);
   $madeupid = "\<".(1900+$year).(1+$mon)."$mday$hour$min$sec$$\@$postinghost\>"; 	
   $head->add('Message-ID',$madeupid);
   }

my @headers;

#path should be at the top. The others are less critical
push @headers,"Path: not-for-mail\n";
push @headers,"Newsgroups: $newsgroup\n";
push @headers,"Approved: $gatewayname\n";
push @headers,"NNTP-Posting-Host: $postinghost\n";
push @headers,"Distribution: local\n";

# Headers we want from the message. We delete the To: so as not to expose the gateway
# You may want to add others.
# 
# RFC 1036 states all USENET news messages must be formatted as valid Internet mail
# messages, according to the Internet standard RFC-822 and adds some of its own.

foreach my $h (qw(
		  Date From Cc Subject Organization Reply-To Followup-To
		  Keywords Summary
		  Message-ID References In-Reply-To
		  MIME-Version Content-Type Content-Transfer-Encoding
		  X-Priority X-MSMail-Priority X-Newsreader X-MimeOLE 
		  X-RFC2646 X-Complaints-To X-Abuse-Info 
		  X-Sender X-Mailer
		 )) {
  if (defined (my $text = $head->get($h))) {
    chomp $text;		# may or may not have newlines...
    push @headers,"$h: $text\n";
  }
}

#Add a newline after the headers
push @headers,"\n";

# in case inews dumps core or something crazy
$SIG{'PIPE'} = "plumber";
sub plumber { die "$program: \"$news_poster_program\" died prematurely!\n"; }

open (INEWS, "| $news_poster_program $news_poster_options") || die "$program: can't run $news_poster_program\n";

print  INEWS @headers;  
print INEWS while <STDIN>;   # gobble rest of message
    
close INEWS;
exit $?;