#!/usr/local/bin/perl

###################################################################
# Credits
###################################################################
# Richard 'Rick' Hernandez,  Mail/News/Sys Admin/Analyst
# rick@pobox.com My Home Page
#
# "@(#) mail2news Version 1.0 06/18/96"
# "@(#) author: rick@sparc.sandiegoca.ncr.com (Richard 'Rick' Hernandez)"
#
# This is basically a new version of mail2news. I don't really
# know who to credit for the 10 lines that I lifted from the previous
# verson, apologies in advance.
#
# Usual disclaimer:  No guarantees of any kind.
# Freeware, will assist in maintenance and answer questions, when I can.
###################################################################

###################################################################
## user setup
###################################################################
$perlpath       = "/usr/local/bin/perl";
$mail2newspath  = "/home/usenet/bin/mail2news";
$mailer         = "/usr/ucb/mail -s";
  # Set $textfix = 1 to substitute '+' for '>' to get around the
  # "Too much included text", syndrome
$textfix        = 0;
$sleeptime      = 30; # Set for sleeptime before 2nd try
$fail_list      = "postmaster usenet";
$approvedHeader = "Approved: usenet@sparc.sandiegoca.ncr.com (News Admin)\n";
$domainname     = "sparc.sandiegoca.ncr.com";
$inews          = "/usr/local/bin/inews";
### Debug
# $inews          = "/usr/local/bin/inews -D";
# end user setup
###################################################################

die "$program: can't find inews\n" unless -x $inews;

###################################################################
## environment controls
###################################################################
die "No news server specified.\n" unless length $ENV{'NNTPSERVER'};
$nntpserver     = $ENV{'NNTPSERVER'};
die "No newsgroup specified.\n" unless length $ENV{'NEWSGROUP'};
$newsgroup      = $ENV{'NEWSGROUP'};
die "Where is the article?\n" unless length $ENV{'ARTICLE'};
$article        = $ENV{'ARTICLE'};
# Retry variable
$redo           = $ENV{'STATUS'};
# end environment controls

###################################################################
## HEADER munging loop
###################################################################
## Read in entire header and join broken lines
open (ARTICLE, "<$article") || die "program: can't open $article\n";
$/="";                        # set break at blank instead of return
$Header = 
;          # read to first blank line
$/="\n";                      # reset break on return 
$Header =~ s/\n[ \t]+/ /go;   # join RFC822 split lines
@HEAD = split(/\n/, $Header); # split along newlines

## set Organization Name ##
$orgname = "unknown";
foreach (@HEAD) { $orgname = $_ if (/^Organization: /io); }
$orgname =~ s/^Organization: (.*)$/$1/io if ($orgname ne "unknown");
$orgname =~ s/'//go;

open (INEWS, "| $inews -h -o '$orgname' -S")
	|| die "program: can't run $inews\n";
foreach (@HEAD) {           # parse joined header lines

    # Toss Path: header, if it exists, don't know where its been.
    next if /^Path:/io;

    # Toss Newsgroups: header, defined in environment
    next if /^Newsgroups:/io;

    ## transform real From: line back to icky style
	$_ = &parse_from("$_") if (/^From: /io);

    ## Hacks, message-id fixes
    if (/^Message-ID:/io) { ## if its not an IP address ...
		($_, $X) = &parse_msgid($_)
			unless (/@\[[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\]>/o);
		print INEWS "$X\n" if (length($X));
   	}

    if ($saw_subject && /^Subject: /io) {
		print INEWS "X-$_\n";
		next;
	}

    print INEWS "$_\n"
		if /^(From|Subject|Date|Path|Newsgroups|Message-ID|References):/io;
    $saw_subject |= ( $+ eq 'Subject' );
}

print INEWS "Newsgroups: $newsgroup\n";
print INEWS "Subject: Untitled\n" unless $saw_subject;
print INEWS $approvedHeader;
print INEWS "\n";
# End Header Munging Loop
###################################################################

###################################################################
# Body Work
###################################################################
if ($redo && $textfix) {
    while (
) {
        s/^>/+/;
        print INEWS;
    }
} else {
    print INEWS while 
; # gobble rest of message
}

###################################################################
# Trailers
###################################################################
close ARTICLE;
close INEWS;
$rc = $?;
if ($rc >> 8) {
    if ($redo) { # if this is a redo failure
        system("$mailer 'News Posting Failure' $fail_list <$article");
        exit $rc;
    }
	sleep $sleeptime;
    $ENV{'STATUS'} = 1;
    exec $perlpath, $mail2newspath, 'ps_check';
    # ps_check is just a way to check for loops, not used.
}

# Got here, got posted, remove the temporary article file
unlink $article;
exit $rc;
# The End
###################################################################

###################################################################
# Functions
###################################################################

sub parse_from {
	$address = $name = "";
	$addr = $foundname = 0;
	s/^From:\s+//io;
	if (/<.*>/) {
		$address = $_;
		$address =~ s/^.*<(.*)>.*$/$1/o;
		s/\s*<.*>\s*//o;
		$addr = 1;
	} elsif (/\[SMTP:/) { ## MSMail crap...
		$address = $_;
		$address =~ s/^.*\[SMTP:(.*)\].*$/$1/io;
		s/\s*\[SMTP:.*\]\s*//io;
		$addr = 1;
	}
	
	if (/\(.*\)/) {
		$name = $_;
		$name =~ s/^.*\((.*)\).*$/($1)/io;
		s/\s*\(.*\)\s*//io;
		$foundname = 1;
	}
	
	if ($addr && ! $foundname) {
		$name = "($_)";
	} elsif ($foundname) {
		$address = $_;
	} else {
		$address = $_;
	}

	if ($address !~ /@/) {
		$address .= "@$domainname";
	} else {
		($login, $hostdomain) = split(/@/, $address);
		$address .= "." unless ($hostdomain =~ /\./);
		$address .= "badaddr" unless ($hostdomain =~ /\..+/);
	}
	
	return "From: $address $name";
}

# Fix X.400 bad Message-ID's caused by illegal (to INN) characters.
# If you change this and an article gets reposted with the same
# Message-ID, you make get two articles with the same information.
sub parse_msgid {
	local($id) = @_;
	local($sid, $saved) = ("", "");

	$id =~ s/^Message-Id:\s+//io;
	$id =~ s/\s+$//io;
	$sid = $id;
	$id =~ s/[<>]//go; # remove extra <> symbols inside msgid
	if ($id =~ /[()": ]/o) {
		$id =~ s/[()":]//go;
		$id =~ tr/[\t ]/_/;
	}
	$id = "<$id>";     # replace beginning and ending <> symbols
	unless ($id =~ /@/) {
		$id =~ s/>/@bad.addr>/o;
	} else {
		local ($mailname, $tail) = ("", "");
		local(@junk) = (); # used to remove extra @ symbols
		($mailname, $tail, @junk) = split(/@/, $id);
		$tail .= ">" unless ($tail =~ />$/); # replace > symbol if lost in @junk
		$tail =~ s/\.>/>/o;
		$tail = "bad.addr>" unless (length($tail) > 1);
		$tail =~ s/>/.badaddr>/o unless ($tail =~ /\./o);
		$id = "$mailname@$tail";
	}
	$saved = "X-Message-Id: $sid" unless ($id eq $sid);

	return ("Message-Id: $id", $saved);
}