🚀 go-pugleaf

In article <1992Feb26.193721.8102@Warren.MENTORG.COM>,
tal@Warren.MENTORG.COM (Tom Limoncelli) writes:
> I'd rather have one account called "gate" that I could use to subscribe
> to every mailing list.  A cron job would turn the complete mail file
> into a "rnews" file and pass it off to relaynews.  No muss no fuss.

I have a mail alias called "rlist" that subscribed to several mailing
lists.  When mail arrives, it is passed to a perl script (also called
rlist) that reads a config file to decide what to do with the mail.  The
config file can specify posting to a newsgroup or remailing to a single
address (or both), based on the contents of the headers.  Posting to a
newsgroup is achieved by piping to rnews.

When I wrote rlist, I was receiving several mailing lists via a
convoluted path that would place the original headers inside the body of
the message and add a new set of mail headers.  rlist knows how to deal
with the particular formats that I encountered, but does not have
generalised support for handling multiple levels of extra headers.

> Best yet, batches are processed faster.  This will also let me deal
> with crossposting in an intelligent way.  (The sysadmin will have to
> specify regular expressions that can be used on the headers to
> determine which mailing list the message came from.)

My rlist doesn't run in batch mode; it processes each message as it arrives,
feeding the results to rnews.  The config file looks like this:

# Format is:
# field   match-pattern   flags   mail-to   newsgroup   distrib
#
# Field is U, F, T, C, B or S;
# to match Unix-From-Line, From header, To header, Cc, Bcc or Subject.
# It can also be several characters, like 'TCB' to match To or CC or BCC.
#
# Match-pattern is a (perl) regular expression to match the relevant field.
#
# Flags is a comma-delimited set of keywords, or '-' for nothing special.
# Keywords are:
# no-sub-header: information in a subheader below the mail header
#	must be ignored
# no-to: To, CC and BCC lines in a subheader must be ignored.
# x-to: X-To lines must be included.
# header-to: To, CC and BCC lines in the mail header must not be ignored.
#
# Mail-to is an address to which the message will be mailed, or '-' for none.
# No more than one mail address may be specified.
#
# Newsgroup says which newsgroup the message will be posted to.
# Distrib is the distribution.
# Both may be overridden by headers in the message itself.
#
#############################################################################

F   na-mhsnews-request@ics.uci.edu -	-	list.mhsnews		uninet
U   com-priv[0-9]*-forw		-	-	list.com-priv		uninet
TC  com-priv			-	-	list.com-priv		uninet
U   nisi-owner			-	-	list.nisi		uninet
TC  nisi			-	-	list.nisi		uninet
TC  ietf-osi-x400ops		-	-	list.ietf-osi-x400ops	uninet
TC  rfc931-users		-	-	list.rfc931-users	uninet


I am appending a shar of the current version of rlist, but be warned that
it contains a lot of cruft.

--apb
Alan Barrett, Dept. of Electronic Eng., Univ. of Natal, Durban, South Africa
RFC822: barrett@ee.und.ac.za             Bang: m2xenix!quagga!undeed!barrett

# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Alan P Barrett <barrett@undeed> on Wed Mar  4 10:11:08 1992
#
# This archive contains:
#	rlist	
#

LANG=""; export LANG
PATH=/bin:/usr/bin:$PATH; export PATH

echo x - rlist
cat >rlist <<'@EOF'
#!/usr/bin/perl
	eval 'exec /usr/bin/perl -S "$0" ${1+"$@"}'
		if $running_under_some_shell;
#
# $Header: rlist.pl,v 1.17 91/10/11 07:45:09 barrett Exp $
#
# rlist -- do something sensible with messages received from a mailing list
#	
# Author: A P Barrett, Mar 1990
#
##################################################################

#
# Main program
#
    #
    # Version number
    #
    $RCS_version = '$Revision: 1.17 $'; # RCS will update this for us
    @temp = split (/\s+/, $RCS_version);
    $version_number = $temp[1];
    $program_version = "rlist $version_number";

    #
    # Current time
    #
    $start_time = &rfc822time();

    #
    # Configuration parameters
    #
    # System and user names inserted in various places in outbound messages.
    #
    #    If there is no From: line,
    #      'From: $fake_from_user_name@$mail_name'
    #    will be inserted.
    #
    #    If there is no Path: line,
    #      'Path: $fake_feed_name!$fake_from_user_name'
    #    will be inserted.  If there is a Path: line, $fake_feed_name will be
    #    added to it.
    #
    #    If there is a problem, mail will be sent to
    #    $administrator_name@$mail_name.
    #
    #	 If the Path already starts with $mail_name or $uucp_name or
    #	 $domain_name or $news_sys_name, that will be deleted.
    #
    ($domain_name = `hostname`) && chop ($domain_name)
	    || die "cannot get hostname: $!\n";

    ($uucp_name = `uuname -l`) && chop ($uucp_name)
	    || die "cannot get uucp name: $!\n";

    $news_lib_dir = "/usr/lib/news";

    if (open (MAILNAME, "$news_lib_dir/mailname")) {
	($mail_name = <MAILNAME>) =~ s/\s+//g;
	close (MAILNAME);
    }
    else {
	$mail_name = $domain_name;
    }

    if (open (WHOAMI, "$news_lib_dir/whoami")) {
	($news_sys_name = <WHOAMI>) =~ s/\s+//g;
	close (WHOAMI);
    }
    else {
	$news_sys_name = $uucp_name;
    }

    #
    $fake_feed_name = 'fakefeed'; # empty string to disable
    $fake_from_user_name = 'news'; # for Path and From lines
    $administrator_name = 'news'; # mail error messages to this user
    #
    # Name of the disposition data file, which describes what to do with
    # incoming messages
    #
    $disposition_data_file = '/usr/lib/news/rlist.data';
    #
    # Name of the log file, and a string which says what should be logged.
    # log_flags is a comma-separated list of keywords, chosen from the set
    # (date,from,size,disposition,header,message,news-header,news-id).
    #
    $log_file = '/tmp/rlist.log'; # action log file, or null for no log
    $log_flags = 'date,from,disposition,news-id'; # what to log
    #
    # Should we add a REceived: header line to outbounf mail messages?
    #
    $add_mail_received_line = 1; # 0 or 1
    #
    # Should we add a disclaimer line to outbound news articles,
    # and if do, what should it look like?
    #
    $add_news_disclaimer = 1; # add a disclaimer to the news header? (0 or 1)
    $news_disclaimer = # may be added to news header
"X-Gatewayed: by $news_sys_name ($program_version); $start_time\n";
    #
    # Which programs will be used to deliver outbound mail and news?
    #
    $mail_program = '/usr/lib/sendmail -em -oi -odq'; # how to send mail
    $news_program = '/usr/bin/rnews'; # how to post news

    #
    # Process command line args
    #
    $argv_newsgroup = shift (@ARGV) if $#ARGV >= 0;

    #
    # Log the current time
    #
    &write_log ("date", "Date-Processed: $start_time\n");
    #
    # Read the mail header,
    # and the sub-header (if any),
    # and the message body.
    #
    # The present implementation reads the entire message body into memory.
    # There had better be enough memory!
    #
    &write_log ("header", "-- Mail header --\n");
    &read_mail_header();
    &skip_blank_lines();
    &write_log ("header", "-- Sub-header --\n");
    &read_sub_header();
    &skip_blank_lines();
    &write_log ("message", "-- Message body --\n");
    &read_message_body();
    &kill_boring_trailer_lines();
    &write_log ("header", "-- End --\n");
    #
    # Log message source and size
    #
    &write_log ("from", "Unix-From-Line: $unix_from_line")  if $unix_from_line;
    &write_log ("from", $mail_header{'from'});
    &write_log ("size", sprintf ("Size: %d+%d+%d lines\n",
	    1+$#mail_header, 1+$#sub_header, 1+$#message_body));
    #
    # Dispose of the message in the appropriate manner
    #
    &choose_disposition();
    if (! $disp_mail_to  && ! $disp_post_news) {
	&debug ("could not determine proper disposition\n");
	&write_log ("disposition",
	    "Disposition: mailing to administrator: $administrator_name\n");
	&error_to_admin ("could not determine proper disposition");
    }
    if ($disp_mail_to) {
	&debug ("mailing to $disp_mail_to\n");
	&write_log ("disposition", "Disposition: mailing to: $disp_mail_to\n");
	&mail_message ($disp_mail_to);
    }
    if ($disp_post_news) {
	&debug ("posting to ".$news_header{'newsgroups'});
	&write_log ("disposition", "Disposition: posting to ".$news_header{'newsgroups'});
	&write_log ("news-id", "News-".$news_header{'message-id'});
	&post_news_article();
    }
    #
    # Write a blank line to the log file
    #
    &write_log (".*", "\n");
    exit (0);

##################################################################

sub get_line
#
# Returns the next physical line from the input.  Also sets $_.
# Allows for unget_line to be used.
# Remembers when eof occurs, to avoid the strange behaviour
# that results from reading <> after it has returned eof once.
#
{
    if ($#unget_line_buffer >= $[) {
	$_ = shift (@unget_line_buffer);
    } elsif ($get_line_iseof) {
	$_ = "";
    } else {
	if (! ($_ = <>)) {
	    $get_line_iseof = 1;
	}
    }
    $_; # return function result
}

##################################################################

sub unget_line
#
# Unget's a line, so that get_line will return it next time.
#
{
    local ($line) = @_;
    push (@unget_line_buffer, $line);
}

##################################################################

sub get_header_field
#
# Reads and returns the next header field (which may consist of
# several physical lines).  Also sets $_.
# If the next input line does not look like a header line, returns the
# null string.
# If the header consists of several physical lines, with normal RFC822
# continuation lines, then the returned string will use '\n' to separate
# the physical lines.
#
# If the 'do_unsplit' argument is true, then a line that doesn't look like the
# start of a new header field, and is not a proper RFC822 continuation
# line, may be appended to the previous line on the assumption that this
# line and the previous line were really supposed to be one physical
# line, but another program split them.  When this happens, the result
# returned by this subroutine will include a \n character between the
# lines; the caller should delete it if desired.
#
{
    local ($do_unsplit) = @_;
    local ($field);
    #
    # Get and process the first line
    #
    &get_line();
    if ($_ eq "") {
	# End of file
	$field = "";
    } elsif (! /^[-a-zA-Z0-9]+:/) {
	# Cannot be the first line of a header field
	&unget_line ($_);
	$field = "";
    } else {
	#
	# It does look like (the first line of) a header field.
	# Loop getting more lines until something that
	# doesn't look like a continuation line is found.
	#
	$field = $_;
	continuation_loop: for (;;) {
	    &get_line();
	    if ($_ eq "") {
		# End of file
		last continuation_loop;
	    } elsif (/^\s*\n$/) {
		# Blank (but possibly not empty) line
		&unget_line ($_);
		last continuation_loop;
	    } elsif (/^[-a-zA-Z0-9]+:/) {
		# The start of the next header field
		&unget_line ($_);
		last continuation_loop;
	    } elsif (/\s/) {
		# A proper continuation line
		$field .= $_;
	    } elsif ($do_unsplit) {
		# Assume it should really have been part of the previous
		# physical line
		$field .= $_;
	    } else {
		# Doesn't look like anything interesting.
		# It must be part of the body of the text.
		&unget_line ($_);
		last continuation_loop;
	    }
	}
    }
    #
    # Return the result
    #
    $_ = $field;
}

##################################################################

sub get_unix_from_line
#
# If the next line in the file looks like a Unix 'From_' line,
# then return it (and set $_).  Otherwise return the empty string.
#
{
    &get_line();
    if (! /^>?From /) {
	&unget_line ($_);
	$_ = "";
    }
    $_; # return result
}

##################################################################

sub get_unix_from_lines
#
# Get and return zero or more Unix 'From_' lines.
#
{
    local ($result) = "";
    do {
	$result .= &get_unix_from_line();
    } while $_;
    $_ = $result;
}

##################################################################

sub skip_blank_lines
#
# Read and discard blank lines, until the next non-blank line.
#
{
      &get_line() while /^\s*\n$/;
      &unget_line ($_)   if ($_); # don't try to unget the EOF
}

##################################################################

sub read_mail_header
#
# Reads the mail header fields into the @mail_header array.
# Also stores the headers in an associative array.
#
# If the first line looks like a Unix From_ line, it is stored in the
# global variable $unix_from_line.
#
{
    local ($fieldname);

    $unix_from_line = &get_unix_from_lines();
    &write_log ("header", $unix_from_line)  if $unix_from_line;
    while (&get_header_field (0)) {
	&write_log ("header", $_);
	push (@mail_header, $_);
	@temp = split (/:/);
	($fieldname = shift (@temp)) =~ y/A-Z/a-z/;
	$mail_header{$fieldname} = $_;
    }
}

##################################################################

sub read_sub_header
#
# Reads any sub-header fields into the @sub_header array.
# Also stores the headers in an associative array.
#
# Allows for the possibility that lines may have been split
# before we saw the message.
#
# If the first line looks like a Unix From_ line, it is stored in the
# global variable $sub_header_unix_from.
#
{
    local ($fieldname);

    $sub_header_unix_from = &get_unix_from_lines();
    &write_log ("header", $sub_header_unix_from)  if $sub_header_unix_from;
    while (&get_header_field (1)) {
	&write_log ("header", $_);
	push (@sub_header, $_);
	@temp = split (/:/);
	($fieldname = shift (@temp)) =~ y/A-Z/a-z/;
	s/\n(\S)/$1/g; # join lines that shouldn't really have been spli
	$sub_header{$fieldname} = $_;
    }
    if ($sub_header_unix_from && ! $fieldname) {
	# there wasn't really a subheader, and what we thought
	# was a Unix from line was really part of the body
	@temp = split (/\n/, $sub_header_unix_from);
	pop (@temp); # get rid of the last empty element
	while ($#temp >= 0) { # unget lines in reverse order
	    &unget_line (pop (@temp) . "\n");
	}
	$sub_header_unix_from = "";
    }
}

##################################################################

sub read_message_body
#
# Reads the message body into the @message_body array.
#
# The message had better be short enough to fit inside whatever
# virtual memory is available to us!!!
#
{
    while (&get_line()) {
	&write_log ("message", $_);
	push (@message_body, $_);
    }
}

##################################################################

sub kill_boring_trailer_lines
#
# Delete boring lines from the end of the message body.
#
# The followint lines are boring:
#   Blank lines
#   Fidonet 'SEEN-BY' lines
#  
{
    while ($#message_body >= 0) {
	$_ = $message_body[$#message_body];
	if (/^\s*$/ || /^SEEN-BY:/) {
	    # it's a boring line, so kill it
	    $#message_body -= 1;
	} else {
	    # it's not a boring line, so exit from the loop
	    last;
	}
    }
}

##################################################################

sub choose_disposition
#
# Decide what to do with the message.
#
# Tries to find a matching line in the disposition data file, and then
# sets global variable $disp_mail_to to the empty string or to a mail
# address to which the message must be sent.
# Sets global variable $disp_post_news to 0 or 1 according to
# whether or not the message must be posted to any newsgroups.
# Sets global variable $disp_flags to the disposition flags.
#
{
    local ($match_field, $match_pattern, $mail_to,
		$newsgroup, $distrib);
    local ($found);
    #
    # If there was a newsgroup name on the command line, that takes
    # precedence over ethe distribution file
    #
    if ($argv_newsgroup) {
	($match_field, $match_pattern, $disp_flags, $mail_to, $newsgroup,
		$distrib) = ('-', '-', '-', '-', $argv_newsgroup, '-');
    }
    else {
	#
	# Open the disposition data file,
	# read it (ignoring blank lines and #-comments),
	# until a matching line is found.
	#
	$found = 0;
	if (open (disp_file, $disposition_data_file)) {
	    read_disp_line: while (<disp_file>) {
		chop;
		if (/^\s*$/) { next read_disp_line; }
		if (/^\s*#/) { next read_disp_line; }
		($match_field, $match_pattern, $disp_flags, $mail_to,
			$newsgroup, $distrib) = split;
		# &debug ("disp line: $_\n");
		# &debug ("disp fields: $match_field $match_pattern\n");
		if (($match_field =~ /U/ &&
			    $unix_from_line =~ /$match_pattern/i)
		 || ($match_field =~ /F/ &&
			    $mail_header{'from'} =~ /$match_pattern/i)
		 || ($match_field =~ /S/ &&
			    $mail_header{'sender'} =~ /$match_pattern/i)
		 || ($match_field =~ /T/ &&
			    $mail_header{'to'} =~ /$match_pattern/i)
		 || ($match_field =~ /C/ &&
			    $mail_header{'cc'} =~ /$match_pattern/i)
		 || ($match_field =~ /B/ &&
			    $mail_header{'bcc'} =~ /$match_pattern/i)
		   ) {
		    &debug ("found matching disp line\n");
		    $found = 1;
		    last read_disp_line;
		}
	    }
	    close (disp_file);
	}
	#
	# If no match was found, fake it.
	#
	if (! $found) {
	    ($match_field, $match_pattern, $disp_flags, $mail_to, $newsgroup,
		    $distrib) = ('-', '-', '-', '-', '-', 'local');
	}
    }
    #
    # Build a suitable news header, in case it is needed.
    #
    &build_news_header ($newsgroup, $distrib);
    #
    # Set global variables to say what must happen
    #
    if ($mail_to =~ /^-?$/) {
	$disp_mail_to = "";
    } else {
	$disp_mail_to = $mail_to;
    }
    if ($news_header{'newsgroups'}) {
	$disp_post_news = 1;
    } else {
	$disp_post_news = 0;
    }
}

##################################################################

sub build_news_header
#
# Build a header for a news article.
# The header is stored in the associative array @news_header.
#
# on exit, $news_header{'newsgroups'} will be empty or undefined if
# the message should not be posted to news.
#
{
    local ($newsgroup, $distrib) = @_;
    local ($field, $value);
    local ($no_sub_header) = &word_in_comma_list ("no-sub-header", $disp_flags);
    local ($header_to) = &word_in_comma_list ("header-to", $disp_flags);
    local ($no_to) = &word_in_comma_list ("no-to", $disp_flags);
    local ($x_to) = &word_in_comma_list ("x-to", $disp_flags);
    #
    # Unless the 'no-sub-header' flag was set, copy stuff from the
    # sub-header.  If the 'no-to' flag was set, don't copy To, CC and BCC fields.
    #
    if (! $no_sub_header) {
	while (($field, $value) = each(sub_header)) {
	    if ($value && ! ($no_to && $field =~ /^(to|cc|bcc)$/)) {
		$news_header{$field} = $value;
	    }
	}
    }
    #
    # Copy interesting things from the mail header, unless they conflict
    # with what is already there.
    #
    if (! $news_header{'from'}) {
	# There was probably no sub-header at all.
	# Copy From and Sender from mail header.
	foreach $field (('from', 'sender')) {
	    $news_header{$field} = $mail_header{$field}
		      unless $news_header{$field} || ! $mail_header{$field};
	}
    }
    foreach $field (('subject', 'message-id', 'newsgroups', 'path', 'date',
		  'distribution', 'approved', 'followup-to', 'organization',
		  'expires', 'reply-to', 'references', 'control', 'keywords',
		  'summary')) {
	$news_header{$field} = $mail_header{$field}
		      unless $news_header{$field} || ! $mail_header{$field};
    }
    #
    # Perhaps we should look for To, CC and BCC headers in the mail header.
    #
    if ($header_to) {
	foreach $field (('to', 'cc', 'bcc')) {
	    $news_header{$field} = $mail_header{$field}
		      unless $news_header{$field} || ! $mail_header{$field};
	}
    }
    #
    # Perhaps we should look for an x-to mail header.
    # Ignore it anyway if it says 'All' (this handles Fidonet messages).
    #
    if ($x_to) {
	if ($mail_header{'x-to'} !~ /x-to:\s*all\s*$/i) {
	    $news_header{'x-to'} = $mail_header{'x-to'}
		      unless $news_header{'x-to'} || ! $mail_header{'x-to'};
	}
    }
    #
    # Set things from the arguments passed to the subroutine
    #
    if ($newsgroup !~ /^-?$/) {
	$news_header{'newsgroups'} = "Newsgroups: $newsgroup\n"
				unless $news_header{'newsgroups'};
    }
    if ($distrib !~ /^-?$/) {
	$news_header{'distribution'} = "Distribution: $distrib\n"
				unless $news_header{'distribution'};
    }
    #
    # Some headers are required by news.  Make sure they are present.
    # One exception is 'newsgroups' -- if it is not there, then the
    # message will not be posted to news.
    #
    # (The Path will be modified later to insert the fake_feed_name.)
    #
    $news_header{'path'} = "Path: $fake_from_user_name\n";
    $news_header{'from'} = "From: $fake_from_user_name@$domain_name\n"
				unless $news_header{'from'};
    $news_header{'date'} = "Date: $start_time\n"
				unless $news_header{'date'};
    $news_header{'subject'} = "Subject: None\n"
				unless $news_header{'subject'};
    $news_header{'message-id'} = "Message-Id: <rlist.".time.".$$@$domain_name>\n"
				unless $news_header{'message-id'};
    #
    # Insert the fake feed name into the Path.
    #
    {
	# Delete local system name from the front of the path.  It might or
	# might not be there, and (let's be a bit paranoid) might be a
	# uucp or domain name instead of being the news name.
	$news_header{'path'} =~
	s/(Path:\s*)($news_sys_name|$uucp_name|$domain_name|$mail_name)!/$1/i;

	# Insert fake_feed_name, if defined
	$news_header{'path'} =~ s/(Path:\s*)(\S)/$1$fake_feed_name!$2/i
				if $fake_feed_name;

	# (don't) Insert local system name
	# $news_header{'path'} =~ s/(Path:\s*)(\S)/$1$news_sys_name!$2/i;
    }

    #
    # Fix any lines that have the wrong format.
    # XXX - could be stricter here
    #
    foreach $field (('from', 'sender')) {
	$news_header{$field} = &mung_news_from_field ($news_header{$field});
    }
    $news_header{'date'} = &mung_news_date_field ($news_header{'date'});
    $news_header{'message-id'} =~ s/\s//g;	# kill spaces
    $news_header{'message-id'} =~ s/:/: /;	# except after first colon
    $news_header{'message-id'} .= "\n";		# and newline at end

    #
    # If there is no Approved header, then add one.
    # This is only necessary if the message is going into a
    # moderated newsgroup, but it does no harm otherwise.
    #
    $news_header{'approved'} = "Approved: $fake_from_user_name@$domain_name ($program_version)\n"
				unless $news_header{'approved'};
}

##################################################################

sub mung_news_from_field
#
# Mung the addresses in a From (or Sender) field, attempting to
# convert illegal addresses to a legal form.
#
# This implementation is rather simple-minded.  In particular,
# it may be confused by stuff inside comments, or by exotic
# address formats.
#
{
    local ($field) = @_;

    #
    # Change 'user' to 'user@$domain_name'
    #
    $field =~ s/([:,]\s*<?)([^!@()<>\s]+)(>?\s*(\n$|[,(]))/$1$2@$domain_name$3/g;
    #
    # Change 'node!user' to 'user@node'
    # Change 'relay!node!user' to 'node!user@relay'
    #
    $field =~ s/([:,]\s*<?)([^!@()<>\s]+)!([^@()<>\s]+)(>?\s*(\n$|[,(]))/$1$3@$2$4/g;
    #
    # Uncomment this to change 'local-part@node' to 'local-part@node.UUCP'
    #
    ####$field =~ s/([:,]\s*<?)([^()<>\s]+)@([^.@()<>\s]+)(>?\s*(\n$|[,(]))/$1$2@$3.UUCP$4/g;
    #
    # If it is still wrong, turn it into a comment.
    # 'm2xenix!Joe Bloggs' --> 'nobody@nowhere (m2xenix!Joe Bloggs)'
    #
    $field =~ s/([:,]\s*<?)([^@()<>]+)(>?\s*(\n$|[,(]))/$1nobody@nowhere ($2)$3/g;
    #
    # Return result
    #
    $field;
}

##################################################################


sub mung_news_date_field
#
# Mung the Date field, attempting to convert to a legal form.
#
# This implementation is rather simple-minded, but that doesn't
# matter much because mail dates are usually valid.
#
{
    local ($field) = @_;
    local ($fieldname,$rest);
    local ($wday,$mday,$month,$year,$time,$tz);
    local ($result);

    # split into components

    ($fieldname,$rest) = split (/\:\s*/, $field, 2);
    $rest =~ m/^\s*((\S+)\s*\,)?\s*(\d+)\s+(\S+)\s+(\d+)(\s+([:\d]+)(\s+(\S+)(\s+.*\S)?)?)?\s*$/;
    #              12              3       4       5     6  7       8   9    0
    #                Mon     ,       01     Jan     1970     12:34        TZ junk
    ($wday,$mday,$month,$year,$time,$tz) = ($2,$3,$4,$5,$7,$9);

    # validate components
    undef $wday
	unless $wday =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat)$/i;
    undef $mday
	unless ($mday >= 1 && $mday <= 31);
    undef $month
	unless $month =~ /^(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)$/i;
    $year = $year + 1900
	if $year < 1900;
    $time = "00:00"
	unless $time =~ /^\d\d\:\d\d(\:\d\d)?$/;
    $tz =~ s/EST/-0500/i;
    $tz =~ s/EDT/-0400/i;
    $tz =~ s/CST/-0600/i;
    $tz =~ s/CDT/-0500/i;
    $tz =~ s/MST/-0700/i;
    $tz =~ s/MDT/-0600/i;
    $tz =~ s/PST/-0800/i;
    $tz =~ s/PDT/-0700/i;
    $tz = "GMT"
	unless $tz =~ /^([-+]\d{4}|UT|GMT)$/i;
    
    if ($mday && $month && $year && $time) {
	$result = $wday ? "$wday, " : "";
	$result .= "$mday $month $year $time $tz";
    } else {
	$result = &rfc822time();
    }

    # return the result
    "$fieldname: $result\n";

}

##################################################################

sub mail_message
#
# Mail the message to somebody.
#
# Fakes the envelope FROM address to be '$fake_from_user_name' on the
# local machine, but otherwise mails the entire message
# in its original form.
#
{
    local ($recipient) = @_;

    #
    # open a pipe to the mailer
    #
    open (rmail, "|$mail_program " . &sh_quote($recipient))
    || &error_to_admin ("could not execute $mail_program $recipient");
    #
    # Write a fake Unix from line  (ctime ends with a \n).
    #
    # If there is a delivery problem, the error message should come
    # back to the fake_from_user_name, rather than going to the original
    # sender.
    #
    print rmail "From $fake_from_user_name " , &ctime();
    #
    # Insert a Received line
    #
    if ($add_mail_received_line) {
	print rmail "Received: by $domain_name ($program_version); $start_time";
    }
    #
    # Write the mail header, a blank line, the sub-header, another blank
    # line, and the body of the message.
    #
    print rmail @mail_header;
    print rmail "\n";
    print rmail $sub_header_unix_from if $sub_header_unix_from;
    if ($#sub_header >= 0) {
	print rmail @sub_header;
	print rmail "\n";
    }
    print rmail @message_body;
    #
    # Close the pipe and check for errors
    #
    close (rmail);
    if ($? != 0) {
	&error_to_admin ("$mail_program $recipient returned status $?");
    }
}

##################################################################

sub post_news_article
#
# Posts the message to news
#
{
    #
    # open a pipe to the news program
    #
    open (rnews, "|$news_program")
    || &error_to_admin ("could not execute $news_program");
    #
    # Write the news header, a blank line, and the body of the message.
    #
    &write_log ("news-header", "-- News header --\n");
    &write_log ("news-header", values(news_header));
    print rnews values(news_header);
    if ($add_news_disclaimer) {
	&write_log ("news-header", $news_disclaimer);
	print rnews $news_disclaimer;
    }
    print rnews "\n";
    if (&word_in_comma_list ("no-sub-header", $disp_flags)) {
	print rnews $sub_header_unix_from if $sub_header_unix_from;
	print rnews @sub_header;
	print rnews "\n" if ($sub_header_unix_from || $#sub_header >= 0);
    }
    print rnews @message_body;
    &write_log ("news-header", "-- End --\n");
    #
    # Close the pipe and check for errors
    #
    close (rnews);
    if ($? != 0) {
	&error_to_admin ("$news_program returned status $?");
    }

}

##################################################################

sub sh_quote
#
# quote a string so that the shell won't mess with it
#
{
    local ($string) = @_;
    $string =~ s/'/'"'"'/g;
    $string = "'".$string."'";
}

##################################################################

sub error_to_admin
#
# Attempts to mail an error message to the administrator
#
{
    local ($reason) = @_;

    &write_log (".*", "Error:  $reason\n");
    open (rmail, "|$mail_program $administrator_name")
    || die "could not execute $mail_program $administrator_name\n";
    print rmail "From $fake_from_user_name " . &ctime().
	  "From: $fake_from_user_name@$domain_name ($program_version)\n".
	  "To: $administrator_name@$domain_name\n".
	  "Date: ". &rfc822time() ."\n".
	  "Subject: rlist error\n".
	  "\n".
	  "The following message could not be processed by rlist.\n".
	  "Reason:  $reason\n".
	  "Message follows:\n\n";
    print rmail $unix_from_line if $unix_from_line;
    print rmail @mail_header;
    print rmail "\n";
    print rmail $sub_header_unix_from if $sub_header_unix_from;
    if ($#sub_header >= 0) {
	print rmail @sub_header;
	print rmail "\n";
    }
    print rmail @message_body;
    close (rmail);
    if ($? != 0) {
	die ("$mail_program $administrator_name returned status $?\n");
    }
}

##################################################################

sub ctime
#
# Returns the date in Unix ctime format  (complete with a \n at the end).
#
# "Sun Sep 16 01:03:52 1973\n"
#
{
    local ($string);
    local ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst)
	    = localtime(time);
    $string = substr ("SunMonTueWedThuFriSat", 3*$wday, 3) . " "
	    . substr ("JanFebMarAprMayJunJulAugSepOctNovDec", 3*$month, 3)
	    . sprintf (" %2d %02d:%02d:%02d %04d\n",
		      $mday, $hour, $min, $sec, 1900+$year);
}

##################################################################

sub rfc822time
#
# Returns the date in RFC822 format
#
# "Sun, 16 Sep 1973 01:03:52 GMT"
#
{
    local ($string);
    local ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst)
	    = gmtime(time);
    $string = substr ("SunMonTueWedThuFriSat", 3*$wday, 3)
	    . sprintf (", %02d ", $mday)
	    . substr ("JanFebMarAprMayJunJulAugSepOctNovDec", 3*$month, 3)
	    . sprintf (" %4d %02d:%02d:%02d GMT",
		      (1900+$year), $hour, $min, $sec);
}

##################################################################

sub word_in_comma_list
#
# Checks whether a word (actually a regular expression)
# appears as one of the elements of a string of comma-
# separated words.
#
# Returns "" if not found, or the actual word if found.
#
{
    local ($word, $string) = @_;
    local ($regexp) = "(^|,)($word)(,|\$)";
    (($string =~ /$regexp/) ? $2 : "");
}

##################################################################

sub write_log
#
# Writes to the log file.
#
# First arg is a regular expression that must match
# a word in the (comma-delimited) $log_flags string.
# If it doesn't match, logging is not performed.
#
{{
    local ($type) = shift (@_);
    local ($type, $regexp);
    #
    # Don't log anything if we are told not to
    #
    last if (! $log_file || ! $log_flags);
    #
    # Don't log this item if we are not interested in it.
    #
    if (! &word_in_comma_list ($type, $log_flags)) {
	# &debug ("not logging $type\n");
	last;
    }
    #
    # Open the log file if necessary.
    #
    if (! $log_file_is_open) {
	if (! ($log_file_is_open = open (log_file, ">>$log_file"))) {
	    &debug ("could not open log file: $log_file\n");
	    last;
	}
	&debug ("opened log file: $log_file\n");
    }
    #
    # Write to the log file
    #
    print log_file @_;
}}

##################################################################

sub debug
{
    print stderr @_; # comment out for no debugging
}

##################################################################
@EOF

chmod 755 rlist

exit 0