#! /usr/bin/perl -w

=head1 NAME

m2n - a mail2news(1) replacement

=head1 SYNOPSIS

m2n.pl [I<options>]

=head1 DESCRIPTION

A replacement for I<mail2news> from the newsgate package. Uses I<rnews> instead
of I<inews> by default, and is much less insistent on removing useful headers.

=head1 OPTIONS

Long option names may be abbreviated to uniqueness.

=over 8

=item B<--stdout>

Send output to standard output rather than directly to I<rnews>.

=item B<-a>, B<--approved>=I<approved>

Approved: line, if none is specified.

=item B<-d>, B<--distribution>=I<distribution>

Distribution: line, if none is specified.

=item B<-n>, B<--newsgroups>=I<newsgroups>

Newsgroups: line, overriding any such provided. Newsgroups: lines in the input
will be saved in X-Mail2News-Newsgroups: lines.

=item B<-o>, B<--organization>=I<organization>

Organization: line, if none is specified.

=item B<-s>, B<--subject>=I<subject>

Subject: line, if none is specified; the default is "no subject".

=item B<-x>, B<--path>=I<path>

Path: prefix, if none is specified; the default is "gateway".

=back

=head1 ERROR REPORTING

Errors will be logged using syslog(3).

=head1 SEE ALSO

mail2news(1).

=head1 AUTHOR

I<m2n> and this manual page were written by Colin Watson <cjw44@cam.ac.uk>.

=cut

use strict;

use Date::Format;
use Digest::MD5 qw(md5_base64);
use Getopt::Long;
use Sys::Syslog qw(:DEFAULT setlogsock);

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

# Use syslog(3) for error output.

setlogsock 'unix';
openlog 'mail2news', 'pid', 'news';

sub syslogdie(@)
{
    syslog 'err', @_;
    closelog;
    exit;
}

# Option processing.

my $tostdout = 0;
my ($approved, $distribution, $newsgroups, $organization);
my $subject = 'no subject';
my $path = 'gateway';

Getopt::Long::Configure qw(bundling bundling_override);
GetOptions(
    "stdout" => \$tostdout,
    "approved|a=s" => \$approved,
    "distribution|d=s" => \$distribution,
    "newsgroups|n=s" => \$newsgroups,
    "organization|o=s" => \$organization,
    "subject|s=s" => \$subject,
    "path|x=s" => \$path);

# Read headers.

my $headerblock = '';
my $extra = '';
my %headers = ();
my ($hname, $hvalue);
my $overridden = 0;

while (<>)
{
    if (/^$/)
    {
	syslogdie 'No headers found, aborting' unless defined $hname;
	$headers{lc $hname} = $hvalue;
	last;
    }
    elsif (/From /)
    {
	next;
    }
    elsif (/^(\s.*)/)
    {
	my $line = $1;
	syslogdie "Continuation line at start of headers: '$line'"
	    unless defined $hvalue;
	$hvalue .= $line;
    }
    elsif (/^(.*?):[ \t](.*)/)
    {
	$headers{lc $hname} = $hvalue if defined $hname;
	$overridden = 0;
	$hname = $1;
	$hvalue = $2;
	if ($hname =~ /newsgroups/i && defined $newsgroups)
	{
	    $hname = 'X-Mail2News-Newsgroups';
	    $headerblock .= "Newsgroups: $newsgroups\n";
	    $headers{newsgroups} = $newsgroups;
	    $overridden = 1;
	}
	elsif ($hname =~ /path/i && defined $path)
	{
	    $hvalue = "$path!$hvalue";
	}
	$_ = "$hname: $hvalue\n";
    }
    elsif (/^(.*?):\n/)
    {
	$headers{lc $hname} = $hvalue if defined $hname;
	$overridden = 0;
	$hname = $1;
	$hvalue = '';
	if ($hname =~ /newsgroups/i && defined $newsgroups)
	{
	    $hname = 'X-Mail2News-Newsgroups';
	    $headerblock .= "Newsgroups: $newsgroups\n";
	    $headers{newsgroups} = $newsgroups;
	    $overridden = 1;
	}
	elsif ($hname =~ /path/i && defined $path)
	{
	    $hvalue = $path;
	}
	$_ = "$hname: $hvalue\n";
    }
    else
    {
	my $line = $_;
	syslogdie "Invalid header line: '$line'";
    }
	
    if ($overridden)	{ $extra .= $_; }
    else		{ $headerblock .= $_; }
}

local $/ = undef;
my $body .= <>;

# Headers from command line

$extra .= "Approved: $approved\n"
    if defined $approved		and not defined $headers{approved};
$extra .= "Distribution: $distribution\n"
    if defined $distribution		and not defined $headers{distribution};
$extra .= "Newsgroups: $newsgroups\n"
    if defined $newsgroups		and not defined $headers{newsgroups};
$extra .= "Organization: $organization\n"
    if defined $organization		and not defined $headers{organization};
$extra .= "Subject: $subject\n"
    if defined $subject			and not defined $headers{subject};
$headerblock = "Path: $path\n$headerblock"
    if defined $path			and not defined $headers{path};

# Other required header checks

syslogdie 'No From: line, aborting'	unless defined $headers{from};
$extra .= time2str 'Date: %a, %e %h %Y %T GMT' . "\n", time, 'GMT'
					unless defined $headers{date};
$extra .= sprintf "Message-ID: <mail2news.\%x.\%s\@riva.ucam.org>\n",
	    time, md5_base64($body)	unless defined $headers{'message-id'};

# Output to stdout or rnews.

if ($tostdout)
{
    print $headerblock, $extra, "\n", $body;
}
else
{
    $SIG{PIPE} = 'IGNORE';
    open RNEWS, '| rnews -v 2>/dev/null'    or syslogdie "can't fork: \%m";
    print RNEWS $headerblock, $extra, "\n", $body
					    or syslogdie "can't write: \%m";
    close RNEWS				    or syslogdie "can't close: \%m";
}

closelog;

