2 # fixscript will replace this line with require innshellvars.pl
4 # mailpost - Yet another mail-to-news filter
6 # $Id: mailpost.in 7795 2008-04-26 08:28:08Z iulius $
8 # 21feb00 [added "lc" to duplicate header fixer stmt to make it case-insensitive]
9 # doka 11may99 [fixed duplicate headers problem]
10 # brister 19oct98 [cleaned up somewhat for Perl v. 5. and made a little more robust]
11 # vixie 29jan95 [RCS'd]
12 # vixie 15jun93 [added -m]
13 # vixie 30jun92 [added -a and -d]
14 # vixie 17jun92 [attempt simple-minded fixup to $path]
15 # vixie 14jun92 [original]
29 unlink ($tmpfile) if $tmpfile ; # in case we die()
30 unlink ($tmpfile2) if $tmpfile2 ; # in case we die()
42 openlog $usage, "pid", $inn::syslog_facility ;
44 $usage .= "[ -r addr ][ -f addr ][ -a approved ][ -d distribution ]" .
45 " [ -m mailing-list ][ -b database ][ -o output-path ] [ -c wait-time ]" .
46 " [ -x header[:header...] ] [ -p port ] newsgroups" ;
48 use vars qw($opt_r $opt_f $opt_a $opt_d $opt_m $opt_b $opt_n $opt_o $opt_h $opt_c $opt_x $opt_p) ;
49 getopts("hr:f:a:d:m:b:no:c:x:p:") || die "usage: $usage\n" ;
50 die "usage: $usage\n" if $opt_h ;
53 # $Submit is a program which takes no arguments and whose stdin is supposed
54 # to be a news article (without the #!rnews header but with the news hdr).
57 my $Sendmail = $inn::mta ;
58 my $Submit = $inn::inews . " -S -h" . ($opt_p ? " -p $opt_p" : '');
59 my $Database = ($opt_b || $inn::pathtmp) . "/mailpost-msgid" ;
60 my $Maintainer = $inn::newsmaster || "usenet" ;
61 my $WhereTo = $opt_o || $Submit ;
62 my $Mailname = $inn::fromhost ;
64 # Can't use $inn::pathtmp as we're usually not running as news.
65 my $Tmpdir = "/var/tmp" ;
67 if ($debugging || $opt_n) {
72 chop ($Mailname = `/bin/hostname`) if ! $Mailname ;
76 # Our command-line argument(s) are the list of newsgroups to post to.
78 # There may be a "-r sender" or "-f sender" which becomes the $path
79 # (which is in turn overridden below by various optional headers).
81 # -d (distribution) and -a (approved) are also supported to supply
82 # or override the mail headers by those names.
86 my $newsgroups = undef;
88 my $distribution = undef;
89 my $mailing_list = undef;
90 my $references = undef;
93 if ($opt_r || $opt_f) {
94 $path = $opt_r || $opt_f ;
95 push @errorText, "((path: $path))\n" ;
99 $approved = &fix_sender_addr($opt_a);
100 push @errorText, "((approved: $approved))\n";
104 $distribution = $opt_d ;
105 push @errorText, "((distribution: $distribution))\n";
109 $mailing_list = "<" . $opt_m . "> /dev/null";
110 push @errorText, "((mailing_list: $mailing_list))\n";
113 my $exclude = 'Organization|Distribution';
115 $exclude .= '|' . join('|', split(/:/, $opt_x));
118 $newsgroups = join ",", @ARGV ;
120 die "usage: $0 newsgroup [newsgroup ...]\n" unless $newsgroups;
124 # Do the header. Our input is a mail message, with or without the From.
127 #$message_id = sprintf("<mailpost.%d.%d@%s>", time, $$, $Hostname);
128 my $real_news_hdrs = '';
129 my $weird_mail_hdrs = '';
130 my $fromHdr = "MAILPOST-UNKNOWN-FROM" ;
131 my $dateHdr= "MAILPOST-UNKNOWN-DATE" ;
132 my $msgIdHdr = "MAILPOST-UNKNOWN-MESSAGE-ID" ;
138 my $subject = "(NONE)";
142 if ( $debugging || -t STDERR ) {
145 syslog "err", "empty input" ;
153 if (/^From\s+([^\s]+)\s+/) {
155 push @errorText, "((path: $path))\n";
157 if (/ remote from /) {
158 $path = $' . '!' . $path;
166 last if defined($line) && ($line =~ /^$/) ;
169 last unless defined $_ ;
172 # Gather up a single header with possible continuation lines into $line.
175 $msg = "First line with leading whitespace!" ;
176 syslog "err", $msg unless -t STDERR ;
184 # On the first header, $line will be undefined.
185 ($_, $line) = ($line, $_) ; # Swap $line and $_.
187 last if defined($_) && /^$/ ;
188 next if /^$/ ; # Only on first header will this happen.
190 push @errorText, "($_)\n";
192 next if /^Approved:\s/sio && defined($approved);
193 next if /^Distribution:\s/sio && defined($distribution);
195 if (/^($exclude):\s*/sio) {
196 $real_news_hdrs .= "$_\n";
200 if (/^Subject:\s*/sio) {
205 if (/^Message-ID:\s*/sio) {
210 if (/^Mailing-List:\s*/sio) {
215 if (/^(Sender|Approved):\s*/sio) {
216 $real_news_hdrs .= "$&" . fix_sender_addr($') . "\n";
220 if (/^Return-Path:\s*/sio) {
222 $path = $1 if ($path =~ /\<([^\>]*)\>/);
223 push@errorText, "((path: $path))\n";
227 if (/^Date:\s*/sio) {
232 if (/^From:\s*/sio) {
233 $from = &fix_sender_addr($');
237 if (/^References:\s*/sio) {
242 if (!defined($references) && /^In-Reply-To:[^\<]*\<([^\>]+)\>/sio) {
243 $references = "<$1>";
247 if (/^(MIME|Content)-[^:]+:\s*/sio) {
248 $real_news_hdrs .= $_ . "\n" ;
252 # Strip out news X-Trace: and X-Complaints-To: headers since otherwise posting
253 # may fail. Other trace headers will be renamed to add 'X-' so we don't have
254 # to worry about them.
255 if (/^X-(Trace|Complaints-To):\s*/sio) {
259 # Random unknown header. Prepend 'X-' if it is not already there.
260 $_ = "X-$_" unless /^X-/sio ;
261 $weird_mail_hdrs .= "$_\n";
265 $msgIdHdr = $message_id if $message_id ;
266 $fromHdr = $from if $from ;
267 $dateHdr = $date if $date ;
270 $path = "$'!$`" if ($path =~ /\@/);
273 $real_news_hdrs .= "Subject: ${subject}\n";
274 $real_news_hdrs .= "Message-ID: ${msgIdHdr}\n" if defined($message_id);
275 $real_news_hdrs .= "Mailing-List: ${mailing_list}\n" if defined($mailing_list);
276 $real_news_hdrs .= "Distribution: ${distribution}\n" if defined($distribution);
277 $real_news_hdrs .= "Approved: ${approved}\n" if defined($approved);
278 $real_news_hdrs .= "References: ${references}\n" if defined($references);
280 # Remove duplicate headers.
282 $real_news_hdrs =~ s/((.*?:) .*?($|\n)([ \t]+.*?($|\n))*)/$headers{lc$2}++?"":"$1"/ges;
284 # inews writes error messages to stdout. We want to capture those and mail
285 # them back to the newsmaster. Trying to write and read from a subprocess is
286 # ugly and prone to deadlock, so we use a temp file.
287 $tmpfile = sprintf "%s/mailpost.%d.%d", $Tmpdir, time, $$ ;
289 if (!open TMPFILE,">$tmpfile") {
290 $msg = "can't open temp file ($tmpfile): $!" ;
292 syslog("err", "$msg\n") unless $debugging || -t STDERR ;
293 open(TMPFILE, "|" . sprintf ($Sendmail, $Maintainer)) ||
294 die "die(no tmpfile): sendmail: $!\n" ;
295 print TMPFILE <<"EOF";
297 Subject: mailpost failure ($newsgroups): $msg
299 -------- Article Contents
304 print TMPFILE <<"EOF";
307 Newsgroups: ${newsgroups}
308 ${real_news_hdrs}Date: ${dateHdr}
313 $rest .= $_ while (<STDIN>);
314 $rest =~ s/\n*$/\n/g; # Remove trailing \n except very last.
320 # We had to bail and mail the article to the admin.
326 ## We've got the article in a temp file and now we validate some of the
327 ## data we found and update our Message-ID database.
330 mailArtAndDie ("no From: found") unless $from;
331 mailArtAndDie ("no Message-ID: found") unless $message_id;
332 mailArtAndDie ("Malformed Message-ID ($message_id)")
333 if ($message_id !~ /\<(\S+)\@(\S+)\>/);
336 # Update (with locking) our Message-ID database. This is used to make sure we
337 # don't loop our own gatewayed articles back through the mailing list.
339 my ($lhs, $rhs) = ($1, $2); # Of message_id matched above.
342 $message_id = "${lhs}\@${rhs}";
344 push @errorText, "(TAS Message-ID database for $message_id)\n";
346 my $lockfile = sprintf("%s.lock", $Database);
348 open(LOCKFILE, "<$lockfile") ||
349 open(LOCKFILE, ">$lockfile") ||
350 mailArtAndDie ("can't open $lockfile: $!") ;
353 for ($i = 0 ; $i < 5 ; $i++) {
354 flock(LOCKFILE, $LOCK_EX) && last ;
358 mailArtAndDie ("can't lock $lockfile: $!") if ($i == 5) ;
361 dbmopen(%DATABASE, $Database, 0666) || mailArtAndDie ("can't dbmopen $Database: $!");
363 if (defined $DATABASE{$message_id}) {
365 exit 0 if (!$opt_c) ;
368 $newsgroups = &append_newsgroups($DATABASE{$message_id}, $newsgroups) ;
369 syslog "err", "crosspost $newsgroups\n" if $debugging ;
372 #$DATABASE{$message_id} = sprintf "%d.%s", time, 'mailpost' ;
373 $DATABASE{$message_id} = $newsgroups ;
375 mailArtAndDie ("TAS didn't set $message_id") unless defined $DATABASE{$message_id};
377 dbmclose(%DATABASE) || mailArtAndDie ("can't dbmclose $Database: $!") ;
379 flock(LOCKFILE, $LOCK_UN) || mailArtAndDie ("can't unlock $lockfile: $!");
386 undef $tmpfile; # Don't unlink $tmpfile.
391 open(LOCKFILE, "<$lockfile") ||
392 open(LOCKFILE, ">$lockfile") ||
393 mailArtAndDie ("can't open $lockfile: $!") ;
396 for ($i = 0 ; $i < 5 ; $i++) {
397 flock(LOCKFILE, $LOCK_EX) && last ;
400 mailArtAndDie ("can't lock $lockfile: $!") if ($i == 5) ;
402 my $umask_bak = umask();
404 dbmopen(%DATABASE, $Database, 0666) || mailArtAndDie ("can't dbmopen $Database: $!");
408 syslog "err", "check " . $DATABASE{$message_id} . " : $newsgroups\n" if $debugging ;
409 $dup = 1 if ($DATABASE{$message_id} ne $newsgroups) ;
411 dbmclose(%DATABASE) || mailArtAndDie ("can't dbmclose $Database: $!") ;
413 flock(LOCKFILE, $LOCK_UN) || mailArtAndDie ("can't unlock $lockfile: $!");
417 syslog "err", "mismatch $newsgroups\n" if $debugging ;
421 # Replace Newsgroups:.
422 open(TMPFILE, "$tmpfile") || mailArtAndDie ("can't open temp file ($tmpfile): $!") ;
423 $tmpfile2 = sprintf "%s/mailpost-crosspost.%d.%d", $Tmpdir, time, $$ ;
424 if ( !open TMPFILE2, ">$tmpfile2") {
425 $msg = "can't open temp file ($tmpfile2): $!" ;
432 last if defined($_) && /^$/ ;
434 if (/^Newsgroups:\s*/sio) {
435 printf TMPFILE2 "Newsgroups: %s\n", $newsgroups ;
438 print TMPFILE2 "$_\n" ;
440 printf TMPFILE2 "\n" ;
443 $rest .= $_ while (<TMPFILE>);
444 $rest =~ s/\n*$/\n/g; # Remove trailing \n except very last.
446 print TMPFILE2 $rest;
449 rename($tmpfile2, $tmpfile) || mailArtAndDie ("can't rename $tmpfile2 $tmpfile: $!") ;
454 if (!open INEWS, "$WhereTo < $tmpfile 2>&1 |") {
455 mailArtAndDie ("can't start $WhereTo: $!") ;
458 my @inews = <INEWS> ;
464 mailArtAndDie ("inews failed: @inews") ;
474 print STDERR $msg,"\n" if -t STDERR ;
476 open(SENDMAIL, "|" . sprintf ($Sendmail,$Maintainer)) ||
477 die "die($msg): sendmail: $!\n" ;
478 print SENDMAIL <<"EOF" ;
480 Subject: mailpost failure ($newsgroups)
486 if ($tmpfile && -f $tmpfile) {
487 print SENDMAIL "\n-------- Article Contents\n\n" ;
488 open(FILE, "<$tmpfile") || die "open($tmpfile): $!\n" ;
489 print SENDMAIL while <FILE> ;
492 print "No article left to send back.\n" ;
498 exit (0) ; # Using a non-zero exit may cause problems.
503 # Take 822-format name (either "comment <addr> comment" or "addr (comment)")
504 # and return in always-qualified 974-format ("addr (comment)").
506 sub fix_sender_addr {
508 my ($lcomment, $addr, $rcomment, $comment);
511 if ($address =~ /\<([^\>]*)\>/) {
512 ($lcomment, $addr, $rcomment) = (&dltb($`), &dltb($1), &dltb($'));
513 } elsif ($address =~ /\(([^\)]*)\)/) {
514 ($lcomment, $addr, $rcomment) = ('', &dltb($`.$'), &dltb($1));
516 ($lcomment, $addr, $rcomment) = ('', &dltb($address), '');
519 #print STDERR "fix_sender_addr($address) == ($lcomment, $addr, $rcomment)\n";
521 $addr .= "\@$Mailname" unless ($addr =~ /\@/);
523 if ($lcomment && $rcomment) {
524 $comment = $lcomment . ' ' . $rcomment;
526 $comment = $lcomment . $rcomment;
530 $_ .= " ($comment)" if $comment;
532 #print STDERR "\t-> $_\n";
538 # Delete leading and trailing blanks.
550 sub append_newsgroups ($$) {
551 my (@orig) = split(/,/,$_[0]) ;
552 my (@new) = split(/,/,$_[1]) ;
555 foreach $newsgroup (@new) {
556 if ( !grep($_ eq $newsgroup,@orig)) {
557 push @orig, $newsgroup ;
559 # mailArtAndDie ("Duplicate Newsgroups: $newsgroup") ;
562 return join ",", @orig ;