Help with mail2news perl script

[David Mahon]

I'm having a bit of trouble with a mail2news perl script that I've
hacked about to try and get it to do what I want it to do. It is called
with no arguments - mail is piped directly to it.

Presently it takes the mail, checks for important headers and copies
certain headers across, followed by the message.

I am having difficulty with headers that may be split over multiple
lines (like References: headers). How can I make it include those?

Unfortunately I can't tell it to just include lines starting with
whitespace because I don't want it to include parts of other headers
split over multiple lines (like Received: headers).

A better way may have been to have a list of headers to exclude, but
that was more difficult and still resulted in the problem with headers
split over multiple lines.

Secondly, I would like to grab the IP address in the first Received
header to use as X-Trace or some such header. Any ideas?

Here is the script so far:

#!/usr/bin/perl

($program = $0) =~ s%.*/%%;

$news_poster_program = "/usr/bin/rnews";
$news_poster_options = "-r localhost";

# in case inews dumps core or something crazy
$SIG{'PIPE'} = "plumber";
sub plumber { die "$program: \"$news_poster_program\" died
prematurely!\n"; }

open (INEWS, "| $news_poster_program $news_poster_options") ||
die "$program: can't run $news_poster_program\n";

# header munging loop
while (<STDIN>) {
last if /^$/;

s/(?i)^Date/Date/;
s/(?i)^From/From/;
s/(?i)^Reply-To/Reply-To/;
s/(?i)^Subject/Subject/;
s/(?i)^Newsgroups/Newsgroups/;
s/(?i)^Message-Id/Message-ID/;
s/(?i)^References/References/;
s/(?i)^X-No-Archive/X-No-Archive/;
s/(?i)^X-Complaints-To/X-Complaints-To/;
s/(?i)^X-Trace/X-Trace/;

print INEWS

if
/^(Date|From|Reply-To|Subject|Newsgroups|Message-ID|References|X-No-Archi
ve|X-Complaints-To|X-Trace):/i;
$saw_subject |= ( $+ eq 'Subject' );
$saw_msgid |= ( $+ eq 'Message-ID' );
$saw_newsgroup |= ( $+ eq 'Newsgroups' );
$saw_date |= ( $+ eq 'Date' );
$saw_from |= ( $+ eq 'From' );
$saw_x_no_archive |= ( $+ eq 'X-No-Archive' );
}

die "$program: didn't get newsgroup from headers\n"
unless $saw_newsgroup;

die "$program: didn't get from from headers\n"
unless $saw_from;

die "$program: didn't get date from headers\n"
unless $saw_date;

($sec,$min,$hour,$mday,$mon,$year)=localtime(time);
$madeupid = "\<$year$mon$mday.$hour$min$sec.$$\@my.domain\>";

print INEWS "Subject: Untitled\n" unless $saw_subject;
printf INEWS "Message-ID: %s\n", $madeupid unless $saw_msgid;
print INEWS "X-Mail-To-News-Contact: abuse\@my.domain\n";
print INEWS "X-No-Archive: Yes\n" unless $saw_x_no_archive;
print INEWS "Organisation: mail2news\@my.domain\n";
print INEWS "Path: mail2news\n";
print INEWS "\n";

print INEWS while <STDIN>; # gobble rest of message

close INEWS;

exit ( ( $? & 0xff ) == 0 ? ( $? >> 8 ) & 0xff : 70 );

 

[Gunnar Hjalmarsson]

I am having difficulty with headers that may be split over multiple
lines (like References: headers).

Secondly, I would like to grab the IP address in the first Received
header to use as X-Trace or some such header.

Search CPAN. The module Mail::Header comes to mind.