frontends/mailpost.in

   1 #! /usr/bin/perl
   2 # fixscript will replace this line with require innshellvars.pl
   3
   4 # mailpost - Yet another mail-to-news filter
   5 #
   6 # $Id: mailpost.in 7795 2008-04-26 08:28:08Z iulius $
   7 #
   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]
  16
  17 use Getopt::Std;
  18 use IPC::Open3;
  19 use IO::Select;
  20 use Sys::Syslog;
  21 use strict;
  22
  23 my $debugging = 0 ;
  24 my $tmpfile ;
  25 my $tmpfile2 ;
  26 my $msg ;
  27
  28 END {
  29     unlink ($tmpfile) if $tmpfile ;             # in case we die()
  30     unlink ($tmpfile2) if $tmpfile2 ;           # in case we die()
  31 }
  32
  33 my $LOCK_SH = 1;
  34 my $LOCK_EX = 2;
  35 my $LOCK_NB = 4;
  36 my $LOCK_UN = 8;
  37
  38 my $usage = $0 ;
  39 $usage =~ s!.*/!! ;
  40 my $prog = $usage ;
  41
  42 openlog $usage, "pid", $inn::syslog_facility ;
  43
  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" ;
  47
  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 ;
  51
  52 #
  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).
  55 #
  56
  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 ;
  63
  64 # Can't use $inn::pathtmp as we're usually not running as news.
  65 my $Tmpdir = "/var/tmp" ;
  66
  67 if ($debugging || $opt_n) {
  68     $Sendmail = "cat" ;
  69     $WhereTo = "cat" ;
  70 }
  71
  72 chop ($Mailname = `/bin/hostname`) if ! $Mailname ;
  73
  74
  75 #
  76 # Our command-line argument(s) are the list of newsgroups to post to.
  77 #
  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).
  80 #
  81 # -d (distribution) and -a (approved) are also supported to supply
  82 # or override the mail headers by those names.
  83 #
  84
  85 my $path = 'nobody';
  86 my $newsgroups = undef;
  87 my $approved = undef;
  88 my $distribution = undef;
  89 my $mailing_list = undef;
  90 my $references = undef;
  91 my @errorText = ();
  92
  93 if ($opt_r || $opt_f) {
  94     $path = $opt_r || $opt_f ;
  95     push @errorText, "((path: $path))\n" ;
  96 }
  97
  98 if ($opt_a) {
  99     $approved = &fix_sender_addr($opt_a);
 100     push @errorText, "((approved: $approved))\n";
 101 }
 102
 103 if ($opt_d) {
 104     $distribution = $opt_d ;
 105     push @errorText, "((distribution: $distribution))\n";
 106 }
 107
 108 if ($opt_m) {
 109     $mailing_list = "<" . $opt_m . "> /dev/null";
 110     push @errorText, "((mailing_list: $mailing_list))\n";
 111 }
 112
 113 my $exclude = 'Organization|Distribution';
 114 if ($opt_x) {
 115     $exclude .= '|' . join('|', split(/:/, $opt_x));
 116 }
 117
 118 $newsgroups = join ",", @ARGV ;
 119
 120 die "usage:  $0 newsgroup [newsgroup ...]\n" unless $newsgroups;
 121
 122
 123 #
 124 # Do the header.  Our input is a mail message, with or without the From.
 125 #
 126
 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" ;
 133 my $from = undef;
 134 my $date = undef;
 135 my $hdr = undef;
 136 my $txt = undef;
 137 my $message_id ;
 138 my $subject = "(NONE)";
 139
 140 $_ = <STDIN>;
 141 if (!$_) {
 142     if ( $debugging || -t STDERR ) {
 143         die "empty input" ;
 144     } else {
 145         syslog "err", "empty input" ;
 146         exit (0) ;
 147     }
 148 }
 149
 150 chomp $_;
 151
 152 my $line = undef;
 153 if (/^From\s+([^\s]+)\s+/) {
 154     $path = $1;
 155     push @errorText, "((path: $path))\n";
 156     $_ = $';
 157     if (/ remote from /) {
 158         $path = $' . '!' . $path;
 159         $_ = $`;
 160     }
 161 } else {
 162     $line = $_;
 163 }
 164
 165 for (;;) {
 166     last if defined($line) && ($line =~ /^$/) ;
 167
 168     $_ = <STDIN> ;
 169     last unless defined $_ ;
 170     chomp ;
 171
 172     # Gather up a single header with possible continuation lines into $line.
 173     if (/^\s+/) {
 174         if (! $line) {
 175             $msg = "First line with leading whitespace!" ;
 176             syslog "err", $msg unless -t STDERR ;
 177             die "$msg\n" ;
 178         }
 179
 180         $line .= "\n" . $_ ;
 181         next ;
 182     }
 183
 184     # On the first header, $line will be undefined.
 185     ($_, $line) = ($line, $_) ; # Swap $line and $_.
 186
 187     last if defined($_) && /^$/ ;
 188     next if /^$/ ;              # Only on first header will this happen.
 189
 190     push @errorText, "($_)\n";
 191
 192     next if /^Approved:\s/sio && defined($approved);
 193     next if /^Distribution:\s/sio && defined($distribution);
 194
 195     if (/^($exclude):\s*/sio) {
 196         $real_news_hdrs .= "$_\n";
 197         next;
 198     }
 199
 200     if (/^Subject:\s*/sio) {
 201         $subject = $';
 202         next;
 203     }
 204
 205     if (/^Message-ID:\s*/sio) {
 206         $message_id = $';
 207         next;
 208     }
 209
 210     if (/^Mailing-List:\s*/sio) {
 211         $mailing_list = $';
 212         next;
 213     }
 214
 215     if (/^(Sender|Approved):\s*/sio) {
 216         $real_news_hdrs .= "$&" . fix_sender_addr($') . "\n";
 217         next;
 218     }
 219
 220     if (/^Return-Path:\s*/sio) {
 221         $path = $';
 222         $path = $1 if ($path =~ /\<([^\>]*)\>/);
 223         push@errorText, "((path: $path))\n";
 224         next;
 225     }
 226
 227     if (/^Date:\s*/sio) {
 228         $date = $';
 229         next;
 230     }
 231
 232     if (/^From:\s*/sio) {
 233         $from = &fix_sender_addr($');
 234         next;
 235     }
 236
 237     if (/^References:\s*/sio) {
 238         $references = $';
 239         next;
 240     }
 241
 242     if (!defined($references) && /^In-Reply-To:[^\<]*\<([^\>]+)\>/sio) {
 243         $references = "<$1>";
 244         # FALLTHROUGH
 245     }
 246
 247     if (/^(MIME|Content)-[^:]+:\s*/sio) {
 248         $real_news_hdrs .= $_ . "\n" ;
 249         next ;
 250     }
 251
 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) {
 256         next ;
 257     }
 258
 259     # Random unknown header.  Prepend 'X-' if it is not already there.
 260     $_ = "X-$_" unless /^X-/sio ;
 261     $weird_mail_hdrs .= "$_\n";
 262 }
 263
 264
 265 $msgIdHdr = $message_id if $message_id ;
 266 $fromHdr = $from if $from ;
 267 $dateHdr = $date if $date ;
 268
 269 if ($path !~ /\!/) {
 270     $path = "$'!$`" if ($path =~ /\@/);
 271 }
 272
 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);
 279
 280 # Remove duplicate headers.
 281 my %headers = ();
 282 $real_news_hdrs =~ s/((.*?:) .*?($|\n)([ \t]+.*?($|\n))*)/$headers{lc$2}++?"":"$1"/ges;
 283
 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, $$ ;
 288
 289 if (!open TMPFILE,">$tmpfile") {
 290     $msg = "can't open temp file ($tmpfile): $!" ;
 291     $tmpfile = undef ;
 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";
 296 To: $Maintainer
 297 Subject: mailpost failure ($newsgroups):  $msg
 298
 299 -------- Article Contents
 300
 301 EOF
 302 }
 303
 304 print TMPFILE <<"EOF";
 305 Path: ${path}
 306 From: ${fromHdr}
 307 Newsgroups: ${newsgroups}
 308 ${real_news_hdrs}Date: ${dateHdr}
 309 ${weird_mail_hdrs}
 310 EOF
 311
 312 my $rest;
 313 $rest .= $_ while (<STDIN>);
 314 $rest =~ s/\n*$/\n/g;           # Remove trailing \n except very last.
 315
 316 print TMPFILE $rest;
 317 close TMPFILE ;
 318
 319 if ( ! $tmpfile ) {
 320     # We had to bail and mail the article to the admin.
 321     exit (0) ;
 322 }
 323
 324
 325 ##
 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.
 328 ##
 329
 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+)\>/);
 334
 335
 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.
 338
 339 my ($lhs, $rhs) = ($1, $2);     # Of message_id matched above.
 340 $rhs =~ tr/A-Z/a-z/;
 341
 342 $message_id = "${lhs}\@${rhs}";
 343
 344 push @errorText, "(TAS Message-ID database for $message_id)\n";
 345
 346 my $lockfile = sprintf("%s.lock", $Database);
 347
 348 open(LOCKFILE, "<$lockfile") ||
 349     open(LOCKFILE, ">$lockfile") ||
 350     mailArtAndDie ("can't open $lockfile: $!") ;
 351
 352 my $i ;
 353 for ($i = 0 ; $i < 5 ; $i++) {
 354     flock(LOCKFILE, $LOCK_EX) && last ;
 355     sleep 1 ;
 356 }
 357
 358 mailArtAndDie ("can't lock $lockfile: $!") if ($i == 5) ;
 359
 360 my %DATABASE ;
 361 dbmopen(%DATABASE, $Database, 0666) || mailArtAndDie ("can't dbmopen $Database: $!");
 362
 363 if (defined $DATABASE{$message_id}) {
 364
 365   exit 0 if (!$opt_c) ;
 366
 367 ## crosspost -c
 368   $newsgroups = &append_newsgroups($DATABASE{$message_id}, $newsgroups) ;
 369   syslog "err", "crosspost $newsgroups\n" if $debugging ;
 370 }
 371
 372 #$DATABASE{$message_id} = sprintf "%d.%s", time, 'mailpost' ;
 373 $DATABASE{$message_id} = $newsgroups ;
 374
 375 mailArtAndDie ("TAS didn't set $message_id") unless defined $DATABASE{$message_id};
 376
 377 dbmclose(%DATABASE) || mailArtAndDie ("can't dbmclose $Database: $!") ;
 378
 379 flock(LOCKFILE, $LOCK_UN) || mailArtAndDie ("can't unlock $lockfile: $!");
 380 close LOCKFILE ;
 381
 382 ## For crosspost.
 383
 384 if ($opt_c) {
 385   if (fork() != 0) {
 386     undef $tmpfile;  # Don't unlink $tmpfile.
 387     exit 0;
 388   }
 389   sleep $opt_c ;
 390
 391   open(LOCKFILE, "<$lockfile") ||
 392     open(LOCKFILE, ">$lockfile") ||
 393       mailArtAndDie ("can't open $lockfile: $!") ;
 394
 395   my $i ;
 396   for ($i = 0 ; $i < 5 ; $i++) {
 397     flock(LOCKFILE, $LOCK_EX) && last ;
 398     sleep 1 ;
 399   }
 400   mailArtAndDie ("can't lock $lockfile: $!") if ($i == 5) ;
 401
 402   my $umask_bak = umask();
 403   umask(000);
 404   dbmopen(%DATABASE, $Database, 0666) || mailArtAndDie ("can't dbmopen $Database: $!");
 405   umask($umask_bak);
 406
 407   my $dup = undef ;
 408   syslog "err", "check   " . $DATABASE{$message_id} . " :  $newsgroups\n" if $debugging ;
 409   $dup = 1 if ($DATABASE{$message_id} ne $newsgroups) ;
 410
 411   dbmclose(%DATABASE) || mailArtAndDie ("can't dbmclose $Database: $!") ;
 412
 413   flock(LOCKFILE, $LOCK_UN) || mailArtAndDie ("can't unlock $lockfile: $!");
 414   close LOCKFILE ;
 415
 416   if (defined($dup)) {
 417     syslog "err", "mismatch $newsgroups\n" if $debugging ;
 418     exit 0 ;
 419   }
 420
 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): $!" ;
 426     $tmpfile2 = undef ;
 427     die $msg ;
 428   }
 429     for (;;) {
 430     $_ = <TMPFILE> ;
 431     chomp ;
 432     last if defined($_) && /^$/ ;
 433
 434     if (/^Newsgroups:\s*/sio) {
 435       printf TMPFILE2 "Newsgroups: %s\n", $newsgroups ;
 436       next ;
 437     }
 438     print TMPFILE2 "$_\n" ;
 439   }
 440   printf TMPFILE2 "\n" ;
 441
 442   my $rest;
 443   $rest .= $_ while (<TMPFILE>);
 444   $rest =~ s/\n*$/\n/g;         # Remove trailing \n except very last.
 445
 446   print TMPFILE2 $rest;
 447   close TMPFILE2 ;
 448   close TMPFILE ;
 449   rename($tmpfile2, $tmpfile) || mailArtAndDie ("can't rename $tmpfile2 $tmpfile: $!") ;
 450   $tmpfile2 = undef ;
 451
 452 }
 453
 454 if (!open INEWS, "$WhereTo < $tmpfile 2>&1 |") {
 455     mailArtAndDie ("can't start $WhereTo: $!") ;
 456 }
 457
 458 my @inews = <INEWS> ;
 459 close INEWS ;
 460 my $status = $? ;
 461
 462 if (@inews) {
 463     chomp @inews ;
 464     mailArtAndDie ("inews failed: @inews") ;
 465 }
 466
 467 unlink $tmpfile ;
 468
 469 exit $status;
 470
 471 sub mailArtAndDie {
 472     my ($msg) = @_ ;
 473
 474     print STDERR $msg,"\n" if -t STDERR ;
 475
 476     open(SENDMAIL, "|" . sprintf ($Sendmail,$Maintainer)) ||
 477         die "die($msg): sendmail: $!\n" ;
 478     print SENDMAIL <<"EOF" ;
 479 To: $Maintainer
 480 Subject: mailpost failure ($newsgroups)
 481
 482 $msg
 483
 484 EOF
 485
 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> ;
 490         close FILE ;
 491     } else {
 492         print "No article left to send back.\n" ;
 493     }
 494     close SENDMAIL ;
 495
 496 #    unlink $tmpfile ;
 497
 498     exit (0) ;                  # Using a non-zero exit may cause problems.
 499 }
 500
 501
 502 #
 503 # Take 822-format name (either "comment <addr> comment" or "addr (comment)")
 504 # and return in always-qualified 974-format ("addr (comment)").
 505 #
 506 sub fix_sender_addr {
 507     my ($address) = @_;
 508     my ($lcomment, $addr, $rcomment, $comment);
 509     local ($',$`,$_) ;
 510
 511     if ($address =~ /\<([^\>]*)\>/) {
 512         ($lcomment, $addr, $rcomment) = (&dltb($`), &dltb($1), &dltb($'));
 513     } elsif ($address =~ /\(([^\)]*)\)/) {
 514         ($lcomment, $addr, $rcomment) = ('', &dltb($`.$'), &dltb($1));
 515     } else {
 516         ($lcomment, $addr, $rcomment) = ('', &dltb($address), '');
 517     }
 518
 519     #print STDERR "fix_sender_addr($address) == ($lcomment, $addr, $rcomment)\n";
 520
 521     $addr .= "\@$Mailname" unless ($addr =~ /\@/);
 522
 523     if ($lcomment && $rcomment) {
 524         $comment = $lcomment . ' ' . $rcomment;
 525     } else {
 526         $comment = $lcomment . $rcomment;
 527     }
 528
 529     $_ = $addr;
 530     $_ .= " ($comment)" if $comment;
 531
 532     #print STDERR "\t-> $_\n";
 533
 534     return $_;
 535 }
 536
 537 #
 538 # Delete leading and trailing blanks.
 539 #
 540
 541 sub dltb {
 542     my ($str) = @_;
 543
 544     $str =~ s/^\s+//o;
 545     $str =~ s/\s+$//o;
 546
 547     return $str;
 548 }
 549
 550 sub append_newsgroups ($$) {
 551   my (@orig) = split(/,/,$_[0]) ;
 552   my (@new) = split(/,/,$_[1]) ;
 553   my $newsgroup ;
 554
 555   foreach $newsgroup (@new) {
 556     if ( !grep($_ eq $newsgroup,@orig)) {
 557       push @orig, $newsgroup ;
 558     } else {
 559 #      mailArtAndDie ("Duplicate Newsgroups: $newsgroup") ;
 560     }
 561   }
 562   return join ",", @orig ;
 563
 564 }
 565