From vixie@pa.dec.com Thu Jul 23 18:17:39 1992
Received: from relay2.UU.NET by rodan.UU.NET with SMTP 
	(5.61/UUNET-mail-drop) id AA14854; Thu, 23 Jul 92 18:17:30 -0400
Received: from inet-gw-2.pa.dec.com by relay2.UU.NET with SMTP 
	(5.61/UUNET-internet-primary) id AA06917; Thu, 23 Jul 92 18:17:37 -0400
Received: by inet-gw-2.pa.dec.com; id AA25454; Thu, 23 Jul 92 15:17:29 -0700
Received: by usenet.pa.dec.com; id AA02987; Thu, 23 Jul 92 15:17:28 -0700
Date: Thu, 23 Jul 92 15:17:28 -0700
From: vixie@pa.dec.com (Paul Vixie)
Message-Id: <9207232217.AA02987@usenet.pa.dec.com>
To: rsalz@uunet.UU.NET
Subject: well then here's my code - use it, abuse it, or lose it; whatever
Status: RO

#! /usr/bin/perl

# mailpost - yet another mail-to-news filter
# vixie 30jun92 [added -a and -d]
# vixie 17jun92 [attempt simple-minded fixup to $path]
# vixie 14jun92 [original]

#
# $Submit is a program which takes no arguments and whose stdin is supposed
# to be a news article (without the #!rnews header but with the news hdr).
#

$Submit = '/usr/lib/newsbin/input/rnews';

#
# the name we qualify sender addresses with is either the "mailname" from
# the news transport, or the /bin/hostname.
#
if (-r '/usr/lib/news/mailname') {
	chop($Mailname = `cat /usr/lib/news/mailname`);
} else {
	chop($Mailname = `/bin/hostname`);
}

#
# 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.
#

$path = 'nobody';
$newsgroups = undef;
$approved = undef;
$distribution = undef;
while ($#ARGV != -1) {
	$_ = shift(@ARGV);
	if (/^\-[rf]$/) {
		$path = shift(@ARGV);
		print STDERR "((path: $path))\n";
		next;
	}
	if (/^\-a$/) {
		$approved = &fix_sender_addr(shift(@ARGV));
		print STDERR "((approved: $approved))\n";
		next;
	}
	if (/^\-d$/) {
		$distribution = shift(@ARGV);
		print STDERR "((distribution: $distribution))\n";
		next;
	}
	$newsgroups .= ',' if $newsgroups;
	$newsgroups .= $_;
}
die "usage:  $0 newsgroup [newsgroup]\n" unless $newsgroups;

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

$real_news_hdrs = '';
$weird_mail_hdrs = '';
$from = undef;
$date = undef;

$_ = <STDIN>;
die "empty input" unless $_;
chop $_;
$prefetch = undef;
if (/^From\s+([^\s]+)\s+/) {
	$path = $1;
	print STDERR "((path: $path))\n";
	$_ = $';
	if (/ remote from /) {
		$path = $'.'!'.$path;
		$_ = $`;
	}
	$date = $_;
} else {
	$prefetch = $_;
}

for (;;) {
	# XXX - ick.  we should be dealing with multiline headers here.
	if ($prefetch) {
		$_ = $prefetch;
		$prefetch = undef;
	} else {
		$_ = <STDIN>;
		last unless $_;			# EOF?  (no chop yet)
		chop $_;
	}
	print STDERR "($_)\n";
	last unless $_;			# end-of-header (already chopped)

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

	if (/^(Message-Id|Subject|Organization|Distribution):\s*/io) {
		$real_news_hdrs .= "$_\n";
		next;
	}
	if (/^(Sender|Reply-To|Approved):\s*/io) {
		$real_news_hdrs .= "$`$&".&fix_sender_addr($')."\n";
		next;
	}
	if (/^Return-Path:\s*/io) {
		$path = $';
		$path = $1 if ($path =~ /\<([^\>]*)\>/);
		print "((path: $path))\n";
		next;
	}
	if (/^Date:\s*/io) {
		$date = $';
		next;
	}
	if (/^From:\s*/io) {
		$from = &fix_sender_addr($');
		next;
	}
	# random unknown header.  prepend 'X-' if it's not already there.
	$_ = "X-$_" unless (/^X-/io);
	$weird_mail_hdrs .= "$_\n";
}

die "no From: found" unless $from;
die "no Date: found" unless $date;
if ($path !~ /\!/) {
	$path = "$'!$`" if ($path =~ /\@/);
}

$real_news_hdrs .= "Approved: ${approved}\n"         if defined($approved);
$real_news_hdrs .= "Distribution: ${distribution}\n" if defined($distribution);

open(STDOUT, "|$Submit") || die "$Submit: $!";

print <<"EOF";
Newsgroups: ${newsgroups}
Path: ${path}
From: ${from}
${real_news_hdrs}Date: ${date}
${weird_mail_hdrs}
EOF

#
# do the body.  we already wrote the blank line.
#

print <STDIN>;

#
# that's all, folks.
#

close(STDOUT);
exit 0;

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

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

#
# delete leading and trailing blanks
#

sub dltb {
	local($_) = @_;

	s/^\s+//;
	s/\s+$//;
	return $_;
}