#! /usr/bin/perl
#
# mail2news	Inject messages from a mailing list into a news
#		system, or the other way around.
#		Special things done:
#		- Changes Message-IDs (AAARGHH!) to prevent the message
#		  being rejected because it is also gatewayed in some
#		  other group
#		- Reads config file mail2news.conf
#		- Rewrites headers (In-Reply-To -> References) etc
#
# Usage:	mail2news [--mail2news] [newsgroup] < article
# 		mail2news  --news2mail  [listname]  < article
#
# Version:	@(#)mail2news  1.30  12-Jan-1999  miquels@cistron.nl
#

#
#	Define where the configuration file is.
#
$cfg = '/usr/local/etc/mail2news.conf';
#$cfg = 'mail2news.conf';

#
#	Last chance error addres, in case the config file has
#	a syntax error and $gwmaster is still unset.
#
$gwmaster = 'usenet';

#
#	Headers that may not be relayed from mail to news or
#	from news to mail (if we add them explicitly that's fine).
#
@unwanted =	('to', 'cc', 'received', 'nntp-posting-host', 'path',
		 'approved', 'control', 'supersedes', 'status', 'xref',
		 'newsgroups', 'nntp-posting-host', 'distribution',
		 'x-envelope-sender', 'user-agent', 'x-mailing-list',
		 'precedence', 'x-sender', 'x-orcpt',
		 'x-mime-autoconverted', 'x-mailer', 'in-reply-to' );

@unw_m2n  =	(@unwanted, 'x-trace');
@unw_n2m  =	(@unwanted);

#
#	Rip the address out of a header line.
#
sub address {
	my ($adr);

	$adr = @_[0];
	$adr =~ s/^.*:[ \t]+([^\n]*)\n$/$1/;
	# Now delete comment.
	$adr =~ s/\([^)]*\)//g;
	# See what type of address this is.
	if ($adr =~ m/<.*>/) {
		# Address between < and >.
		$adr =~ s/^.*<(.*)>.*$/$1/;
	} else {
		# Just strip spaces at the beginning and the end.
		$adr =~ s/^[ \t]*([^ \t]*)[ \t]*$/$1/;
	}
	$adr;
}

#
#	Rip the fullname out of a header line.
#
sub fullname {
	my ($adr);

	$adr = @_[0];
	if ($adr =~ m/\(([^\)]+)\)/) {
		return $1;
	}
	$adr =~ s/<[^>]+>//;
	$adr =~ s/^\s*(.*)\s*$/$1/;
	$adr;
}

#
#	Send message to gwmaster or other address.
#
sub bailout {
	my ($to, $hdr);
	my ($tty);

	$tty = 0;
	$to = $gwmaster;
	$to = $_[2] if ($_[2]);
	chomp $to;

	$tty = 1 if (-t STDERR);

	if ($tty || $debug) {
		open(XFD, ">&STDERR");
	} else {
		open(XFD, "|$sendmail");
	}
	if (!$tty) {
		print XFD "From: mail2news program <$gwmaster>\n";
		print XFD "Subject: failure notice: mail2news\n";
		print XFD "To: $to\n";
		print XFD "Bcc: $gwmaster\n" if ($gwmaster ne $to);
		print XFD "Precedence: bulk\n";
		print XFD "\n";
	}
	print XFD $_[0];
	if ($_[1] > 0) {
		print XFD "  Called-As: mail2news @ARGV\n";
		for ($i = 0; $i <= $hcount; $i++) {
			$hdr = $header{$header[$i]};
			$hdr =~ s/\n(\s+)/\n  $1/g;
			print XFD "  $hdr";
		}
	}
	close XFD;

	exit 0;
}

#
#	Create a tempfile and return filename.
#	DANGER WILL ROBINSON: this is currently unsafe.
#
sub tempfile {
	return "/tmp/mail2news.$$";
}

#
#	Inews printed something on stderr .. log it.
#
sub inewsfailed {
	open(XFD, ">>$logfile") || bailout "mail2news: $logfile: $!\n";
	print XFD scalar localtime() . ": inews error\n";
	print XFD "\tCalled-As: mail2news @ARGV\n";
	print XFD "\t" . $header{'from'};
	print XFD "\t" . $header{'to'} if ($header{'to'});
	print XFD "\t" . $header{'cc'} if ($header{'cc'});
	print XFD "\t" . $header{'newsgroups'}
			if ($header{'newsgroups'});
	print XFD "\t" . $header{'message-id'};
	if (open(XFD2, $_[0])) {
		print XFD "\n";
		print XFD "\t" . $_ while(<XFD2>);
	}
	close XFD;
	close XFD2;
}

#
#	Read the headers.
#
sub readheaders {
	my ($already);
	my ($cte_seen);

	$hcount = 0;
	$header = '';
	$cte_seen = 0;
	while(<STDIN>) {
		chomp;

		# Skip From_ header.
		next if ($hcount == 0 && /^From /);

		# Continued header.
		if (/^\s/) {
			next if ($hcount == 0);
			$header .= $_ . "\n";
			next;
		}

		# Store collected header.
		if ($hname ne '') {
			#
			#	Simplistic check for duplicate headers
			#	with the same content like some
			#	versions of sendmail mistakenly send.
			#
			if ($header{$hname} ne $header &&
			    ($hname ne 'content-transfer-encoding' ||
			     $cte_seen == 0)) {
				$header{$hname} .= $header;
			}
			$cte_seen++ if ($hname eq 'content-transfer-encoding');
		}

		# End of headers ?
		last if (/^$/);

		# Name of new header.
		$hname = $_;
		$hname =~ s/:.*$//;
		$hname = lc $hname;
		$already = $header{$hname} eq '' ? 0 : 1;

		$header = $_ . "\n";
		$header[$hcount++] = $hname if (!$already);
	}
}

#
#	news2mail part.
#
sub news2mail {

	$sender = $header{'from'};
	$sender =~ s/^from:\s*//i;
	chomp $sender;

	#
	#	Find the message ID
	#
	if ($header{'message-id'} eq '') {
		bailout("news2mail: message without message-id!\n", 1, $sender);
	}

	#
	#	Looping?
	#
	if ($x_loop ne '' && $header{'x-loop'} =~ m/$x_loop/) {
		bailout("news2mail: message looping!\n", 1);
	}

	#
	#	Change References to In-Reply-To
	#	Also strip $msgid_prefix from In-Reply-To
	#
	if (defined($header{'references'})) {
		if ($header{'references'} =~ m/(<[^>]+>)\s+$/) {
			$header{'references'} = "In-Reply-To: $1\n";
			$header{'references'} =~ s/<$msgid_prefix([^>]+)>/<$1>/;
		}
	}
	$header{'in-reply-to'} = '';

	#
	#	Find the groups this message was posted to.
	#
	$groups = $header{'newsgroups'};
	$groups =~ s/^newsgroups:\s*//i;
	chomp($groups);

	#
	#	Put the groups, lowercase, into @groups.
	#
	@groups = split(/,\s*/, $groups);

	#
	#	Now walk over the list definitions to see to which
	#	addresses we should mail this article.
	#
	for ($i = 0; $i <= $#lists; $i++) {
		if ($lists[$i]{'group'} eq $list_name) {
			$mail = $lists[$i]{'listaddress'};
			$subscriber = $lists[$i]{'subscriber'};
			$usereplyto = $lists[$i]{'use_reply_to'};
			$nrsubscribers++ if ($subscriber);
			push @mail, $mail unless grep(/^$mail$/, @mail);
		}
		foreach $a (@groups) {
			#print "Compare $lists[$i]{'group'} $a\n";
			if ($lists[$i]{'group'} eq $a) {
				$mail = $lists[$i]{'listaddress'};
				$subscriber = $lists[$i]{'subscriber'};
				$usereplyto = $lists[$i]{'use_reply_to'};
				$nrsubscribers++ if ($subscriber);
				push @mail, $mail
					unless grep(/^$mail$/, @mail);
			}
		}
	}
	$usereplyto = ($usereplyto =~ m/yes/i);

	#
	#	See if we found addresses to mail this to!
	#
	if ($#mail < 0) {
		bailout("news2mail: cannot find address to mail to!\n",
			1, $sender);
	}

	#
	#	Cannot mail to multiple lists if we need to fake
	#	the From: line!
	#
	if ($nrsubscribers > 1) {
		bailout("news2mail: crossposting to multiple closed lists\n",
			1, $sender);
	}

	$addresses = join(",", @mail);

	#
	#	Open sendmail, print the original headers, add our own,
	#	and add the original message.
	#
	$f_flag = " -f$subscriber" if ($subscriber);
	open(FD, $debug ? ">&STDOUT" : "|$sendmail$f_flag");

	for ($i = 0; $i <= $hcount; $i++) {
		$hname = $header[$i];
		next if (grep(/^$hname$/, @unw_n2m));
		#
		#	Sendmail -t does strange things when Resent-
		#	headers are present!
		#
		next if ($hname =~ m/^resent/i);
		if ($hname eq 'from' && $subscriber) {
			print FD "Sender: $sender\n";
			if (($comm = fullname($sender)) ne '') {
				$comm = " ($comm)";
			}
			print FD "From: $subscriber$comm\n";
			if ($usereplyto) {
				print FD "Reply-To: $sender\n";
			}
			next;
		}
		print FD $header{$hname};
	}
	print FD "To: $addresses\n";
	print FD "Errors-To: $gwmaster\n";
	print FD "\n";
	while(<STDIN>) {
		#last if (/^From /); # Debug aid.
		print FD;
	}
	#
	#	May need to add footer.
	#
	if ($subscriber && !$usereplyto) {
		print FD <<EOF;
-- 
The From: and Reply-To: addresses are internal news2mail gateway addresses.
Reply to the list or to $sender
EOF
	}
	close FD;
}

#
#	mail2news part.
#
sub mail2news {

	#
	#	Fix up the message ID
	#
	#	FIXME: do (2) and (3) also in the References:
	#	header, and perhaps reverse these actions
	#	on References lines in news2mail.
	#
	if ($header{'message-id'} eq '') {
		bailout("mail2news: message without message-id!\n", 1);
	}
	# 1. Insert our prefix.
	$header{'message-id'} =~ s/<([^>]+)>/<$msgid_prefix$1>/;
	# 2. Change <blabla@> to <blabla@unknown>
	if ($header{'message-id'} =~ m/\@>/) {
		$header{'message-id'} =~ s/\@>/\@unknown>/;
	}
	# 3. Change all @ signs except the last one to % signs.
	if ($header{'message-id'} =~ m/@.*@/) {
		$header{'message-id'} =~ s/@/%/g;
		$header{'message-id'} =~ s/%([^%]+)$/\@$1/;
	}

	#
	#	Change In-Reply-To to References.
	#	Also munge the message ID in the References: line.
	#
	if (!defined($header{'references'})) {
		if (($ref = $header{'in-reply-to'}) &&
		    ($ref =~ m/(<[^>]+>)/)) {
			$ref = $1;
			$ref =~ s/<([^>]+)>/<$msgid_prefix$1>/;
			$header{'in-reply-to'} = "References: $ref\n";
		}
	} else {
		$header{'references'} =~ s/<([^>]+)>/<$msgid_prefix$1>/g;
	}

	#
	#	Inews replaces the date with it's own, save the
	#	original date.
	#
	if (defined($header{'date'})) {
		chomp ($orig_date = $header{'date'});
		$orig_date =~ s/^date:\s*//i;
	}

	#
	#	Find the lists this message was posted to.
	#
	$to = $header{'to'};
	$cc = $header{'cc'};
	$to =~ s/^to:\s*//i;
	$cc =~ s/^cc:\s*//i;
	$to .= "," . $cc;
	$to =~ s/[\r\n]+//g;
	$to =~ s/^\s*(.*)\s*/$1/;

	#
	#	Put the addresses, lowercase, into @tolist.
	#
	@tolist = split(/,\s*/, $to);
	for ($i = 0; $i <= $#tolist; $i++) {
		$tolist[$i] = lc address($tolist[$i]);
	}

	#
	#	Now walk over the list definitions to see in which
	#	newsgroups we should post this article.
	#
	for ($i = 0; $i <= $#lists; $i++) {
		if ($lists[$i]{'name'} eq $list_name) {
			$group = $lists[$i]{'group'};
			push @groups, $group unless grep(/^$group$/, @groups);
		}
		foreach $a (@tolist) {
			if ($a ne '' && $lists[$i]{'listaddress'} eq $a) {
				$group = $lists[$i]{'group'};
				push @groups, $group
					unless grep(/^$group$/, @groups);
				push @listaddrs, $a;
			}
		}
	}

	#
	#	Unset reply-to header if it's the same as one
	#	of the list addresses.
	#
	if (($a = address($header{'reply-to'})) ne '' &&
	    grep (/^$a$/, @listaddrs)) {
		$header{'reply-to'} = '';
	}

	#
	#	See if we found groups to post this in!
	#
	if ($#groups < 0) {
		bailout("mail2news: cannot find group to post in!\n", 1);
	}

	$newsgroups = join(",", @groups);

	#
	#	Open inews, print the original headers, add our own,
	#	and add the original message.
	#
	if ($debug) {
		$tf = '';
		print "Program: $inews:\n";
		open(FD, ">&STDOUT");
	} else {
		$tf = tempfile();
		open(FD, "|$inews > $tf 2>&1");
	}
	print FD "Path: gateway\n";
	for ($i = 0; $i <= $hcount; $i++) {
		$hname = $header[$i];
		#
		#	We don't care about all the resent- stuff.
		#
		next if ($hname =~ m/^resent/i);
		next if (grep(/^$hname$/, @unw_m2n));
		print FD $header{$hname};
	}
	print FD "X-Orig-Date: $orig_date\n" if ($orig_date);
	print FD "Subject: (none)\n" unless defined($header{'subject'});
	print FD "Newsgroups: $newsgroups\n";
	print FD "Approved: $gwmaster\n";
	print FD "Distribution: $distribution\n" if ($distribution);
	print FD "X-Loop: $x_loop\n" if ($x_loop ne '');
	#print FD "X-Orig-To: ", join(",", @tolist), "\n"; # Debug aid.
	print FD "\n";
	while(<STDIN>) {
		#last if (/^From /); # Debug aid.
		print FD;
	}

	close FD;
	inewsfailed($tf) if ($tf && -s $tf);
	unlink $tf if ($tf);
}

#
#	Read config.
#
eval "require '$cfg'" || bailout ("$@\n", 0);

#
#	See how we were called.
#
$debug = 0;
$m2n = $n2m = 0;
if ($ARGV[0] eq '-d') {
	$debug = 1;
	shift @ARGV;
}
if ($ARGV[0] eq '--mail2news') {
	$m2n = 1;
	shift @ARGV;
} elsif ($ARGV[0] eq '--news2mail') {
	$n2m = 1;
	shift @ARGV;
} elsif ($ARGV[0] !~ m/^-/) {
	$m2n = 1;
}
if ($m2n == 0 && $n2m == 0) {
	bailout("Usage: mail2news --mail2news|--news2mail [listname]\n");
}
if (defined($ARGV[0])) {
	$list_name = $ARGV[0];
}
readheaders();

mail2news() if ($m2n);
news2mail() if ($n2m);

0;
