#! /etc/LOCAL/bin/perl # (C) Copyright 1994 Rahul Dhesi, All rights reserved. # Permission for copying and creation of derivative works is granted, # provided this copyright notice is preserved, to anybody who # does not discriminate against the copyright owner. # $Source: /local/undoc/RCS/mail2rnews,v $ # $Id: mail2rnews,v 1.3 1997/10/05 02:45:59 rdroot Exp $ # $COMMENT = <<'EOF'; Purpose: To take an incoming email message and post it to a newsgroup. The script must be invoked with one or more newsgroups specified as arguments. The incoming message will be cross-posted to all specified newsgroups. Header transformations: Old New --- --- Subject -same- (generated if missing) From -same- Reply-To -same- Organization -same- Date X-Date, and add new date Mime-Version -same- Content-Type -same- Approved -same- To X-To Cc X-Cc Newsgroups Orig-Newsgroups Followup-To Orig-Followup-To Distribution Orig-Distribution Path Orig-Path Special transformations are done on the Message-Id header: (a) Its syntax is fixed so it's legal. (b) The first specified newsgroup is prepended to it, to make the message id different for each copy of a message arriving for different mailing lists. Warnings: 1. This script feeds incoming mail to the 'rnews' that comes with inn. It has not been tested with any other rnews. 2. The original message-id is preserved, except that (a) the mailing list name is prepended to it, and (b) if the message-id syntax appears to be invalid, some transformations are done in an attempt to make it valid. The advantage of this is that duplicates (based on message-id) are automatically suppressed by inn, minmizing to an extent the chances of infinite loops. The disadvantage is that a horribly invalid message-id may prevent an incoming message from being converted into a news posting. The reason we prepend the mailing list name is to allow multiple copies of the same message, that were sent to multiple mailing lists, to be separately processed without duplicate suppression. Thus if the same message arrives twice for the same mailing list, the duplicate will be suppressed. But if two copies of the same message arrive destined for two different mailing lists, both will be accepted. EOF # CONFIGURATION SECTION $myname = "mail2rnews"; # name of this program # prefix string that will be removed from list name before prepending # list name to message-id -- to keep message-id shorter $list_prefix = 'a2i.lists.'; # rnews command to execute. (If tracing is enabled with -t, /bin/cat # will be used instead -- see later below.) ## $rnews = '/usr/lib/sendmail postmaster'; # for debugging $rnews = '/bin/rnews -v'; # Path header to insert in all output $mypath = 'Path: a2i!rahul.net!mail2rnews'; # END CONFIGURATION SECTION $list_prefix =~ s/(\W)/\\$1/g; # change string into pattern $RCSHEADER = '$Source: /local/undoc/RCS/mail2rnews,v $' . "\n" . '$Id: mail2rnews,v 1.3 1997/10/05 02:45:59 rdroot Exp $'; $usage = "usage: $myname [-vtx] [-e perl-code] newsgroup ... (or -h for help)"; if ($ARGV[0] =~ "^-.+" ) { require "getopts.pl"; &Getopts("vtxhe:"); } $debug = $opt_x; $trace = $opt_t; $verbose = $debug || $trace || $opt_v; # suppresss perl warnings ($opt_h && $opt_v && $opt_t && $opt_x && $sigpipe && $verbose); $EX_TEMPFAIL = 75; # sendmail's temp failure error # trap some signals $SIG{'PIPE'} = 'sigpipe'; sub sigpipe { warn "$myname: error: SIGPIPE\n"; exit $EX_TEMPFAIL; } if ($opt_h) { &givehelp(); exit(0); } (@ARGV < 1) && &usage_error; $group1 = $ARGV[0]; $group1 =~ s/^$list_prefix//; # Now $group1 is the name of the local newsgroup, minus the constant # list prefix. This will be included in the message-id, so # if the same message arrives for more than one mailing list, each copy # may be posted to different newsgroups without inn suppressing the # duplicates. But duplicates to the same list will still be suppressed. $newsgroups = 'Newsgroups: ' . join(',', @ARGV); $COMMENT = <<'EOF'; The following table tells us how to deal with various headers. In the table, each key is a header name in lowercase, and the value for that key is one of the following: copy Copy this header intact to output. prepend-x Prepend arbitrary string x to the name of the header and send the result to output. The code also has special knowledge of the following headers: subject If none is found, one will be generated. message-id Checked for valid syntax. If invalid, an attempt is made to make it valid. Also, the $list_prefix string is inserted after the opening angle bracket of the message-id string. Continuations are handled properly, and header formatting is preserved. Thus headers may span multiple lines. EOF %hdrtab = ( 'from', 'copy', # copy intact into output 'subject', 'copy', 'date', 'copy', 'reply-to', 'copy', 'organization', 'copy', 'x-organization', 'copy', 'message-id', 'copy', # but with special processing 'mime-version', 'copy', 'content-type', 'copy', 'approved', 'copy', 'to', 'prepend-X-', # prepend X- 'cc', 'prepend-X-', # prepend X- 'newsgroups', 'prepend-Orig-', # prepend Orig- 'followup-to', 'prepend-Orig-', 'distribution', 'prepend-Orig-', 'path', 'prepend-Orig-', 'date', 'prepend-Orig-', # and generate new Date: ); # processing begins here $inhdr = 1; # state -- either in hdr or in body @headers = (); # will accumulate headers $action = undef; # action to take on current header and any continuation if ($trace) { $rnews = '/bin/cat'; } open(OUTF, "|$rnews"); $error = 0; # to keep track of output errors while () { s/\n//; # don't chop in case of missing newline if ($inhdr) { if (/^\s*$/) { # end of headers $inhdr = 0; $begin_body = 1; # true only when begining body } elsif (/^\s+/) { # if a continuation &continuation($_); } else { &action($_); } } else { if ($begin_body) { &print_headers; # print all headers; &print("\n"); $begin_body = 0; } if ($opt_e) { # if perl code to execute eval $opt_e; $@ && die $@; } &print("$_\n"); } } close(OUTF) || $error++; if ($?) { warn "$myname: warning: pipe returned error $?\n"; exit $EX_TEMPFAIL; } if ($error) { warn "$myname: some error occurred during output\n"; exit $EX_TEMPFAIL; } # Given a header, take some action. Will set global variable $action. sub action { local($line) = @_; local($field, $a); $field = $line; $debug && print "<< $line\n"; $action = undef; if ($field =~ s/:.*$//) { # if in header format $field =~ s/(.)/\l\1/g; # force to lowercase # If we see subject line, make a note of it if ($field eq 'subject') { $saw_subject = 1; } # If invalid message-id, try to fix it if ($field eq 'message-id') { if ($line =~ /:\s*\<(.*)>/) { $id = $1; $id =~ s/^/${group1}./; # change any blanks into X $id =~ s/\s/X/g; # if no @, add one if ($id !~ /\@/) { $id .= '@SOME.WHERE'; } # if no domain after @, add one if ($id !~ /\@.+\./) { $id =~ s/$/.SOMEWHERE/; $id =~ s/(\@.*)\.\./\1.X./g; # separate adjacent dots } $line =~ s/:.*$/: <$id>/; } } $a = $hdrtab{$field}; # get any known action $debug && print "> $field => $a\n"; if ($a) { if ($a eq 'copy') { # if copying header $action = $a; $debug && print "copy => $line\n"; push(@headers, $line); } elsif ($a =~ s/^prepend-//) {# if prepending text $action = 'copy'; # so continuations are copied $line =~ s/^/$a/; $debug && print "prepend $a => $line\n"; push(@headers, $line); } else { warn "$myname: unrecognized action [$a]\n"; } } } else { warn "$myname: warning: invalid line [$line]\n"; } } # handle a continuation line sub continuation { local($line) = @_; if ($action eq 'copy') { push(@headers, $line); } } # Prints accumulated headers. Will also fill in a subject if none # was seen by &action() during header parsing. sub print_headers { # &print("Headers: =====\n"); &print("$mypath\n"); &print("$newsgroups\n"); if (! $saw_subject) { &print("Subject: (none)\n"); } &print('Date: ' . &date . "\n"); for (@headers) { &print("$_\n"); } } # print to output stream; also send debugging mesagess sub print { (print OUTF @_) || $error++; $debug && print ">> $_\n"; } sub usage_error { local($msg) = @_; if ($msg) { die "$msg\n"; } else { die "$usage\n"; } } sub givehelp { ## require 'local/page.pl'; ## &page(<