CCL Home Page
Up Directory CCL mail2news
#!/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); }
Modified: Wed Dec 23 18:09:00 1998 GMT
Page accessed 9944 times since Sat Apr 17 21:24:53 1999 GMT