#! /usr/bin/perl -w
require 5.004;	# my() in control structures
use strict;

# Copyright (C) 2000 Colin Watson <cjw44@flatline.org.uk>
# 
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
# 
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
# 
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software Foundation,
#   Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

use Groupie::Log qw(:all);

BEGIN
{
    # If we're only compiling, then we want to see these in the normal way.
    unless ($^C)
    {
	$SIG{__DIE__} = sub { logerror 1, $_[0] };
	$SIG{__WARN__} = sub { logwarn $_[0] };
    }
}

use Getopt::Long;
# 5.004 had Getopt::Long::config instead, but that's deprecated in 5.005.
unless (exists $Getopt::Long::{Configure})
{
    *Getopt::Long::Configure = \&Getopt::Long::config;
}

use Mail::Address;

use Groupie::ConfigFile qw(:all);
use Groupie::Lib qw(:mailtonews);

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

my $version = '0.1.1';
my $default_configfile = '/etc/groupie/mailtonews.conf';

sub show_version ()
{
    print "mailtonews version $version\n";
    exit 0;
}

sub show_help ()
{
    print <<EOF;
mailtonews version $version. Copyright (c) 2000 Colin Watson. This is free
software; see the GNU General Public License version 2 or later for copying
conditions.

Options:

  --help                        Show this page.
  --version                     Print the current version of mailtonews.

  -C, --config=<config-file>    Use this configuration file rather than
                                $default_configfile.
  -O, --option <name>=<value>   Override the value of a configuration file
                                option.

  -a, --approved=<address>      Approved: line.
  -d, --distribution=<dist>     Distribution: line.
  -n, --newsgroups=<groups>     Newsgroups: line.
  -o, --organization=<org>      Organization: line.
  -s, --subject=<subject>       Subject: line.
  -x, --path=<path>             Path: prefix.

EOF
    exit 0;
}

my %headers;

sub loginfo_msgid ($@)
{
    my ($format, @args) = @_;
    my $msgid = $headers{'message-id'};
    if (defined $msgid)
    {
	loginfo "%s: $format", $msgid, @args;
    }
    else
    {
	loginfo $format, @args;
    }
}

sub logwarn_msgid ($@)
{
    my ($format, @args) = @_;
    my $msgid = $headers{'message-id'};
    if (defined $msgid)
    {
	logwarn "%s: $format", $msgid, @args;
    }
    else
    {
	logwarn $format, @args;
    }
}

sub logerror_msgid ($$@)
{
    my ($exitcode, $format, @args) = @_;
    my $msgid = $headers{'message-id'};
    if (defined $msgid)
    {
	logerror $exitcode, "%s: $format", $msgid, @args;
    }
    else
    {
	logerror $exitcode, $format, @args;
    }
}

# Option processing.
# Add new options to %options (except for ones that are initially undefined)
# and to the argument list for GetOptions().

my %options = (
    config	    => (-f '~/.mailtonewsrc') ? '~/.mailtonewsrc'
					      : $default_configfile,
    option	    => {},
    subject	    => 'no subject',
    path	    => 'gateway',
);

Getopt::Long::Configure qw(no_ignore_case);
GetOptions(\%options,
    'help',
    'version',
    'config|C=s',
    'option|O=s%',
    'approved|a=s',
    'distribution|d=s',
    'newsgroups|n=s',
    'organization|o=s',
    'subject|s=s',
    'path|x=s',
);

show_version if defined $options{version};
show_help if defined $options{help};

# Read configuration file.

%default_config = (
    'active-file' => 'none',			    # unimplemented
    'add-header' => [],
    'add-header-for' => [],			    # unimplemented
    'auto-newgroup' => 'none',			    # unimplemented
    'check-body' => [],				    # unimplemented
    'check-header' => [],
    'daemon-mode' => 0,				    # unimplemented
    'default-headers' => ['To', 'Cc'],
    'fix-date' => 1,
    'fix-message-id' => 1,
    'fix-in-reply-to' => 1,			    # unimplemented
    'fqdn' => 'none',
    'lists-file' => '/etc/groupie/groupie.lists',
    'log-file' => 'syslog',
    'news-control' => '/usr/lib/news/bin/ctlinnd',  # unimplemented
    'output' => '| rnews -v 2>/dev/null',
    'suppress-exitcode' => 1,
    'verbose' => 1,
);
@boolean_props = qw(daemon-mode fix-date fix-message-id fix-inreplyto
		    suppress-exitcode);
@list_props = qw(default-headers);
@multi_props = qw(add-header add-header-for check-body check-header);

init_config $options{config};
setlogfile $config{'log-file'};
setlogname 'mailtonews';

# Override configuration file settings with what we've taken off the command
# line.

while (my ($opt_name, $opt_value) = each %{$options{option}})
{
    if (exists $config{$opt_name})
    {
	$config{$opt_name} = $opt_value;
    }
    else
    {
	logwarn 'Unrecognized option name: %s', $opt_name;
    }
}

# We might need to reset the log file now.
setlogfile $config{'log-file'};

set_lists $config{'lists-file'};

# Save header settings here; we'll use them later.

my %need_headers = ();

# Is this the right place for this? Can't I do it at the end instead?
# FIXME.

foreach my $header (@{$config{'add-header'}})
{
    my ($name, $value) = split /[: ]/, $header;
    $need_headers{lc $name} = [$name, $value];
}

foreach my $header ('Approved', 'Distribution', 'Newsgroups',
		    'Organization', 'Subject', 'Path')
{
    my $hname = lc $header;
    my $hvalue = $options{$hname};
    $need_headers{$hname} = [$header, $hvalue] if defined $hvalue;
}

# Read headers.

my ($hdr, @hdrs, $body);
my $extra = '';
my ($hname, $hvalue);
my $overridden = 0;

$hdr = <>;
$hdr = '' if $hdr =~ /^From /;
{
    local $/ = "\n\n";
    $hdr .= <>;
}
chomp $hdr;

# Various header checks.

logerror 1, 'No headers found, aborting' if $hdr !~ /./;

$hdr =~ s/^([^:\s]*?:)(?:\t|$)/$1 /gm;
$hdr =~ s/^([^:\s]*?:)([^ ])/$1 $2/gm;

if ($hdr =~ /^([^:]*)$/)
{
    logerror 1, 'Invalid header line: %s', $1;
}

$hdr =~ s/^newsgroups: (.*)/X-MailToNews-Newsgroups: $1/gim;
# Yes, I have seen Path: headers beginning with whitespace, so just on the
# off-chance that it might break something ...
$hdr =~ s/^path: +(.*)/Path: $options{path}!$1/gim if defined $options{path};
$hdr .= "Newsgroups: $options{newsgroups}\n" if defined $options{newsgroups};

%headers = map { /(.*?): (.*)/s; (lc $1, $2) } split /\n(?!\s)/, $hdr;

# The headers are OK, so fetch the body.

{
    local $/ = undef;
    $body .= <>;
}

# Now the meat of the processing. Compare various header lines against
# groupie.lists and mailtonews.conf, and turn them into a plausible Newsgroups:
# line.

unless (exists $headers{newsgroups})
{
    my @groups = ();
    foreach my $default_header (@{$config{'default-headers'}})
    {
	next unless exists $headers{lc $default_header};
	my @addresses = map { $_->address }
			    Mail::Address->parse($headers{lc $default_header});
	if (@addresses)
	{
	    my @extra_groups = lists_addresses_to_groups @addresses;
	    last if scalar @extra_groups and not defined $extra_groups[0];
	    push @groups, @extra_groups;
	}
    }

    foreach my $check (@{$config{'check-header'}})
    {
	my ($hname, $patterns) = split ' ', $check, 2;
	next unless exists $headers{lc $hname};
	push @groups, addresses_to_groups $patterns, $headers{lc $hname};
    }

    # Weed out duplicates from the newsgroup list.
    my %seen = ();
    @groups = grep { !$seen{$_}++ } @groups;

    # Have we any newsgroups at all?
    logerror_msgid 1, 'No appropriate newsgroups found' unless scalar @groups;

    loginfo_msgid 'posted to %s', join ',', @groups;
    $extra .= sprintf "Newsgroups: %s\n", join ',', @groups;
}

# Headers from command line

# Put Path: at the top, just because I think it looks cleaner.
if (defined $need_headers{path} and not defined $headers{path})
{
    $hdr = $headers{path} =
	(sprintf "Path: %s\n", $need_headers{path}->[1]) . $hdr;
}

while (my ($header, $hinfo) = each %need_headers)
{
    my ($hname, $hvalue) = @$hinfo;
    $extra .= "$hname: $hvalue\n" unless defined $headers{lc $header};
}

# Other required header checks

unless (defined $headers{from})
{
    logerror_msgid 1, 'No From: header, aborting';
}

unless (defined $headers{date})
{
    if ($config{'fix-date'})
    {
	logwarn_msgid 'No Date: header, fixing';
    }
    else
    {
	logerror_msgid 1, 'No Date: header, aborting';
    }

    eval q{
	use Date::Format;
	$extra .= time2str "Date: %a, %e %h %Y %T GMT\n", time, 'GMT';
    }
}

unless (defined $headers{'message-id'})
{
    if ($config{'fix-message-id'})
    {
	logwarn 'No Message-ID: header in incoming message, fixing';
    }
    else
    {
	logerror 1, 'No Message-ID: header, aborting';
    }

    my $msgid = $headers{'resent-message-id'};
    unless (defined $msgid)
    {
	eval q{
	    use Net::Domain qw(hostfqdn);
	    my $fqdn = $config{'fqdn'};
	    if (not defined $fqdn or $fqdn eq '' or $fqdn eq 'none')
	    {
		defined($fqdn = hostfqdn) or $fqdn = 'localhost';
	    }
	    # Try several ways, depending on what modules are installed.
	    {
		local $SIG{__DIE__};
		$msgid = eval q{
		    use Digest::MD5 qw(md5_base64);
		    sprintf '<mailtonews.%x.%s@%s>',
			time, md5_base64($body), $fqdn;
		};
		return if defined $msgid;
		$msgid = eval q{
		    use POSIX qw(times);
		    sprintf '<mailtonews.%x.%x@%s>',
			time, (POSIX::times())[0], $fqdn;
		};
	    }
	    die $@ if $@;
	};
	die $@ if $@;
    }
    $headers{'message-id'} = $msgid;
    $extra .= "Message-ID: $msgid\n";
    loginfo 'New Message-ID is %s', $msgid;
}

# Output to wherever the user has selected (e.g. stdout or rnews).

$SIG{PIPE} = 'IGNORE';
if ($config{'output'} =~ /^[|>]/)
{
    open OUTPUT, $config{'output'}
	or logerror_msgid 1, "can't open %s: %s", $config{'output'}, $!;
}
else
{
    open OUTPUT, ('>> ' . $config{'output'})
	or logerror_msgid 1, 'can\'t open %s: %s', $config{'output'}, $!;
}
print OUTPUT $hdr, $extra, "\n", $body
    or logerror_msgid 1, "can't write: %s", $!;
close OUTPUT or logerror_msgid 1, "can't close: %s", $!;

exit 0;

END
{
    $? = 0 if $Groupie::ConfigFile::config{'suppress-exitcode'};
}

__END__

=head1 NAME

mailtonews - configurable gateway from mail to Usenet news

=head1 SYNOPSIS

mailtonews [I<options>]

=head1 DESCRIPTION

I<mailtonews> takes mail messages and feeds them, with appropriate header
changes, to a news server; it is a free 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.

I<mailtonews> is highly configurable by way of its configuration files:
I<groupie.lists>(5) contains gatewaying directives which apply both here and
to I<newstomail>, while I<mailtonews.conf>(5) contains some
mail-to-news-specific overrides for these as well as options which affect
the operation of I<mailtonews> at a higher level. Some options may also be
set on the command line, for convenience and for some measure of backward
compatibility with I<mail2news>.

=head1 OPTIONS

Long option names may be abbreviated to uniqueness.

=over 8

=item B<--help>

Display a usage summary.

=item B<--version>

Print the current version of mailtonews.

=item B<-C>, B<--config>=I<config-file>

Configuration file; default is F</etc/groupie/mailtonews.conf>.

=item B<-O>, B<--option> I<name>=I<value>

Set the configuration file option I<name> to I<value>.

=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 line in the input article or any such
line generated while processing the configuration file. Newsgroups: lines in
the input will be saved in X-MailToNews-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 EXIT STATUS

If the I<suppress-exitcode> option in F<mailtonews.conf> is on, then
I<mailtonews> always returns 0, to prevent some mail delivery agents taking
minor failures as delivery errors and returning them to the message sender.

If the I<suppress-exitcode> option is off, then I<mailtonews> returns 0 on
success and 1 on failure.

See also L<NOTES ON MAIL DELIVERY AGENTS> below.

=head1 FILES

=over 8

=item F</etc/groupie/mailtonews.conf>

Configuration file for I<mailtonews>.

=head1 ERROR HANDLING

By default, errors will be logged using syslog(3) rather than to standard
error. The latter is often sent back to the message sender by mail transport
agents, which can cause confusion and embarrassment.

This behaviour is configurable; see I<mailtonews.conf>(5).

=head1 NOTES ON MAIL DELIVERY AGENTS

This section covers only I<exim> and I<procmail>. If you have any
information on how I<mailtonews> can best be used with other MDAs, then
please contact me.

exim filter files use the pipe transport to invoke external programs like
I<mailtonews>. On examining the exit code of such a program, it will either
declare success (with an exit code of zero, or when the ignore_status option
is set), defer delivery until later (if the exit code is one of those listed
in temp_errors), or declare a delivery failure (in all other cases). To my
knowledge, however, there is no way of expressing the following pseudocode
in a filter file:

    pipe message to mailtonews
    if pipe succeeded then finish endif
    continue with normal delivery

Setting ignore_status in F<exim.conf> (if you are the mail administrator) or
setting suppress-exitcode in F<mailtonews.conf> will at least cause delivery
not to fail when I<mailtonews> cannot find any suitable newsgroups for the
message. However, in that case you probably want to go on to deliver the
message to your inbox or similar. Here, your only option is to have some
means of identifying in advance whether I<mailtonews> will be able to find
somewhere to post the message. Checking all the known mailing list addresses
works, but is something of a duplication of effort. Having a mail address to
which only mailing list traffic is delivered (perhaps by adding a suffix to
the local part of your normal address, if you can) is much simpler.

procmail users have a somewhat easier time. The 'W' flag on a procmail
recipe that invokes an external program will wait for the program to finish
and check its exit code. I believe that this will allow you to express the
above sequence of operations as a procmail recipe. FIXME: Can anyone provide
more concrete confirmation of this? I'm not a procmail user.

=head1 SEE ALSO

I<mailtonews.conf>(5), I<groupie.lists>(5), mail2news(1).

=head1 AUTHOR

I<mailtonews> and this manual page were written by Colin Watson
<cjw44@flatline.org.uk>.

=cut
