[comp.lang.perl] Using Perl for news-to-mail pipeline

chip@tct.uucp (Chip Salzenberg) (02/07/91)

According to rkrebs@archie.dsd.es.com (Randall Krebs):
>I just completed massaging our C news system to gateway local mailing
>lists to local newsgroups.

I did the same thing, but for non-local mailing lists.

>I was forced to modify the message injection utilities to strip lines
>out of the message headers.

I took one look at that mess (no insult intended, Geoff and Henry;
it's just hard to follow) and skipped all of it.  The "newsmail"
script, enclosed below, massages the message headers and feeds the
result directly to relaynews.  No muss, no fuss.

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  postmail
# Wrapped by chip@tct on Wed Feb  6 15:30:14 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'postmail' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'postmail'\"
else
echo shar: Extracting \"'postmail'\" \(3690 characters\)
sed "s/^X//" >'postmail' <<'END_OF_FILE'
Xeval 'exec /bin/perl -S $0 ${1+"$@"}'
X	if 0;
X
X# $Id: postmail,v 1.6 90/10/03 11:19:46 news Exp $
X#
X# Post E-Mail to newsgroups.
X#
X# $Log:	postmail,v $
X# Revision 1.6  90/10/03  11:19:46  news
X# Include Date.  Exclude Reply-To.
X# 
X# Revision 1.5  90/08/23  13:27:00  news
X# Be nicer about exit status.
X# 
X# Revision 1.4  90/08/23  13:21:40  news
X# New binary directory.
X# 
X# Revision 1.3  90/06/12  09:35:56  news
X# Deal with broken BITNET paths.  Use relaynews -i flag for logging.
X# 
X# Revision 1.2  90/06/12  09:04:16  news
X# Make it work with relaynews instead of inews.
X# 
X# Revision 1.1  90/06/12  08:47:27  news
X# Initial revision
X# 
X
X#----------------------------------------------------------------
X# Configuration
X#----------------------------------------------------------------
X
X$NEWSBIN = "/u/news/cbin";
X$NEWSLIB = "/u/news/lib";
X
X$WHOAMI = &LINE("$NEWSLIB/whoami");
X$MAILNAME = &LINE("$NEWSLIB/mailname");
X
X$* = 1;		# Newlines in patterns
X
X#----------------------------------------------------------------
X# Options
X#----------------------------------------------------------------
X
X$DIST = "local";
X$DEBUG = 0;
Xwhile (@ARGV) {
X	$_ = $ARGV[0];
X	last unless s/^-//;
X	shift;
X	if ($_ eq "D") {
X		$DEBUG = 1;
X	}
X	elsif ($_ eq "d") {
X		&USAGE unless @ARGV;
X		$DIST = shift;
X	}
X	else {
X		print stderr "invalid option: $_\n";
X		&USAGE;
X	}
X}
X
X&USAGE unless @ARGV;
X
Xsub USAGE {
X	die "usage: postmail [-m] [-d distribution] newsgroups\n";
X}
X
X#----------------------------------------------------------------
X# Process header
X#----------------------------------------------------------------
X
Xopen(ART, $DEBUG ? ">&STDOUT" : "|$NEWSBIN/relay/relaynews -i");
X
Xprint ART "Path: news\n";
Xprint ART "Newsgroups: ", join(",", @ARGV), "\n";
Xprint ART "Distribution: $DIST\n";
X
X$ID = "";
X
X$line = "";
Xwhile (<STDIN>) {
X	last if /^$/;
X	next if /^From /;
X	($line .= $_, next) if /^\s/;
X	if ($line =~ /^(From|Date|Subject):\s*(.+)$/i) {
X		print ART "$1: ", &ADDR($2), "\n";
X	}
X	elsif ($line =~ /^Message-ID:.*<(\S+)>/i) {
X		$ID = $1;
X	}
X	elsif ($line =~ /^In-Reply-To:.*<(\S+)>/i) {
X		print ART "References: <$1>\n";
X	}
X	last if /^$/;
X	$line = $_;
X}
X
Xunless ($ID) {
X	$ID = sprintf("%08X.%04X@%s", time, $$, $WHOAMI);
X}
X
Xprint ART "Message-ID: <$ID>\n";
Xprint ART "Approved: news@$MAILNAME\n";		# Be safe
Xprint ART "\n";
X
X#----------------------------------------------------------------
X# Process body
X#----------------------------------------------------------------
X
Xuntil (eof(STDIN)) {
X	$_ = <STDIN>;
X	print ART;
X}
X
Xclose(ART);
X
Xif ($?) {
X	print stderr "postmail: relaynews exited with status $?\n";
X	exit 1;
X}
Xexit 0;
X
X#----------------------------------------------------------------
X# Parse an address into "user@host (comment)".
X#----------------------------------------------------------------
X
Xsub ADDR {
X	local($_) = @_;
X	local($address, $comment);
X
X	if (s/\((.+)\)//) {
X		$comment = $1;
X		$address = $_;
X	}
X	elsif (s/<(.+)>//) {
X		$address = $1;
X		$comment = $_;
X	}
X	else {
X		$address = $_;
X		$comment = "";
X	}
X
X	$address =~ s/^\s+//;
X	$address =~ s/\s+$//;
X	$comment =~ s/^\s+//;
X	$comment =~ s/\s+$//;
X
X	if (($host, $user) = ("!$address" =~ /!([^!]+)!([^!]+)$/)) {
X		unless ($host =~ /\./) {
X			if ($host =~ /^[A-Z]+$/) {
X				$host .= ".bitnet";
X			}
X			else {
X				$host .= ".uucp";
X			}
X		}
X		$host =~ y/A-Z/a-z/;
X		$address = "$user@$host";
X	}
X
X	$_ = $address;
X	$_ .= " ($comment)" if $comment;
X	return $_;
X}
X
X#----------------------------------------------------------------
X# Read a line from a file
X#----------------------------------------------------------------
X
Xsub LINE {
X	local($FILE) = @_;
X
X	die "$FILE: $!\n" unless open(FILE);
X	$_ = <FILE>;
X	close(FILE);
X	chop;
X	$_;
X}
END_OF_FILE
if test 3690 -ne `wc -c <'postmail'`; then
    echo shar: \"'postmail'\" unpacked with wrong size!
fi
chmod +x 'postmail'
# end of 'postmail'
fi
echo shar: End of shell archive.
exit 0
-- 
Chip Salzenberg at Teltronics/TCT     <chip@tct.uucp>, <uunet!pdn!tct!chip>
 "Most of my code is written by myself.  That is why so little gets done."
                 -- Herman "HLLs will never fly" Rubin