#!/usr/local/bin/perl5
#
# This file is part of SnarfNews
# Copyright (C) 1991,1992,1993,1994,1995,1996 Alec Muffett
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of version 2 of the GNU General Public License as
# published by the Free Software Foundation
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#

$ego = "X-Reflected-By: snarfnews convm2a 1.0\n";
push(@diefields, "x-reflected-by");
push(@skipfields, "received", "status");

# create list of extra fields to skip/die on
while ($ARGV[0] =~ /^-/o)
{
    $flag = shift(@ARGV);

    if ($flag =~ /^-skip-(\S+)$/o)
    {
	$field = $1;
	$field =~ tr/A-Z/a-z/;
	push (@skipfields, $field);
    }
    elsif ($flag =~ /^-die-(\S+)$/o)
    {
	$field = $1;
	$field =~ tr/A-Z/a-z/;
	push (@diefields, $field);
    }
    elsif ($flag eq "-debug")
    {
	$debug++;
    }
}

warn "skip=(@skipfields)\n" if ($debug);
warn "die=(@diefields)\n" if ($debug);

# date in RFC format
chop($date = `/bin/date '+%e %b %y %T %Z'`);

# reprocess header
@header = ();
$doneprint = 0;

while (<STDIN>)
{
    # break to body on blank line
    if (/^\s*$/)
    {
	if ($#ARGV >= 0)
	{
	    foreach (@ARGV)
	    {
		push(@header,  "$_\n");
	    }
	}
	push(@header,  "Date: $date\n");
	unless ($seensubj)
	{
	    push(@header,  "Subject: (none)\n");
	}
	push(@header,  $ego);
	push(@header, $_);
	last;
    }

    # continuation lines
    if (/^\s/oi)
    {
	if ($doneprint)
	{
	    chomp($header[$#header]);
	    $header[$#header] .= $_;
	}
	next;
    }

    # fields to die on
    if (/^([^:]+):/)
    {
	$thisfield = $1;
	$thisfield =~ tr/A-Z/a-z/;

	if (grep {$_ eq $thisfield} @diefields)
	{
	    warn "convm2a: contains pathological header: $thisfield\n" if ($debug);
	    exit 0;
	}

	if (grep {$_ eq $thisfield} @skipfields)
	{
	    $doneprint = 0;
	    next;
	}
    }
    else
    {
	die "convm2a: illegal header: $_";
    }

    # fields to keep verbatim
    if (/^from:/oi ||
	/^subject:/oi ||
	/^reply-to:/oi ||
	/^organization:/oi ||
	/^lines:/oi ||
	/^references:/oi ||
	/^message-id:/oi ||
	/^mime/oi ||
	/^content/oi ||
	/^x-/oi)
    {
	push(@header,  $_);
    }
    elsif (/^from\s/oi)
    {
	# ignore
    }
    else
    {
	push(@header,  "X-$_");
    }

    if (/^subject:/oi)
    {
	$seensubj = 1;
    }

    $doneprint = 1;
}

# check veracity of From: address
$from = (grep(/^from:/oi, @header))[0];
$from =~ s/^from://goi;         # remove header
$from =~ s/\s+/ /oi;            # merge w/s
1 while $from =~ s!\([^\(\)]*\)!!go; # remove nested parens
$from =~ s!.*\<(.*)\>.*!$1!o;   # promote rfc822 addresses
$from =~ s/^\s+//o;
$from =~ s/\s+$//o;

if ($from eq "")
{
    die "convm2a: no from line\n";
}

$fix = undef;

unless ($from =~ /^\S+\@\S+\.\S+/o)
{
    warn "convm2a: detected problem with From: $from\n" if ($debug);

    if ($from =~ /^\@/o)
    {
	die "convm2a: ...no username in From: $from\n";
    }
    elsif ($from =~ /\@[^\.]+$/o)
    {
	warn "convm2a: ...lacking domainname.\n" if ($debug);
	$fix = $ENV{"SNARFDOMAIN"} ||
	    die "convm2a: require SNARFDOMAIN variable\n";
	$from = "$from.$fix";
    }
    else
    {
	warn "convm2a: ...lacking hostname.domainname.\n" if ($debug);
	$fix = $ENV{"SNARFHOST"} ||
	    die "convm2a: require SNARFHOST variable\n";
	$from = "$from\@$fix";
    }

    warn "convm2a: ...revised to From: $from\n" if ($debug);
}

# header of posting
foreach (@header)
{
    if (defined($fix) && /^From:/oi)
    {
	print "From: $from\n";
    }
    else
    {
	print $_;
    }
}

print while (<STDIN>);

exit 0;
