| 1 | #! /usr/bin/perl |
| 2 | require '/usr/lib/news/innshellvars.pl'; |
| 3 | |
| 4 | # mailpost - yet another mail-to-news filter |
| 5 | # 21feb00 [added "lc" to duplicate header fixer stmt to make it case-insensitive] |
| 6 | # doka 11may99 [fixed duplicate headers problem] |
| 7 | # brister 19oct98 cleaned up somewhat for perl v. 5. and made a little more robust. |
| 8 | # vixie 29jan95 RCS'd [$Id: mailpost.in,v 1.3.2.1 2000/08/13 02:03:59 rra Exp $] |
| 9 | # vixie 15jun93 [added -m] |
| 10 | # vixie 30jun92 [added -a and -d] |
| 11 | # vixie 17jun92 [attempt simple-minded fixup to $path] |
| 12 | # vixie 14jun92 [original] |
| 13 | |
| 14 | use Getopt::Std ; |
| 15 | use IPC::Open3; |
| 16 | use IO::Select; |
| 17 | use Sys::Syslog; |
| 18 | use strict ; |
| 19 | |
| 20 | my $debugging = 0 ; |
| 21 | my $tmpfile ; |
| 22 | my $msg ; |
| 23 | |
| 24 | END { |
| 25 | unlink ($tmpfile) if $tmpfile ; # incase we die() |
| 26 | } |
| 27 | |
| 28 | my $LOCK_SH = 1; |
| 29 | my $LOCK_EX = 2; |
| 30 | my $LOCK_NB = 4; |
| 31 | my $LOCK_UN = 8; |
| 32 | |
| 33 | my $usage = $0 ; |
| 34 | $usage =~ s!.*/!! ; |
| 35 | my $prog = $usage ; |
| 36 | |
| 37 | openlog $usage, "pid", $inn::syslog_facility ; |
| 38 | |
| 39 | $usage .= "[ -r addr ][ -f addr ][ -a approved ][ -d distribution ]" . |
| 40 | " [ -m mailing-list ][ -b database ][ -o output-path ] newsgroups" ; |
| 41 | |
| 42 | use vars qw($opt_r $opt_f $opt_a $opt_d $opt_m $opt_b $opt_n $opt_o $opt_h) ; |
| 43 | getopts("hr:f:a:d:m:b:no:") || die "usage: $usage\n" ; |
| 44 | die "usage: $usage\n" if $opt_h ; |
| 45 | |
| 46 | # |
| 47 | # $Submit is a program which takes no arguments and whose stdin is supposed |
| 48 | # to be a news article (without the #!rnews header but with the news hdr). |
| 49 | # |
| 50 | |
| 51 | my $Sendmail = $inn::mta ; |
| 52 | my $Submit = $inn::inews . " -S -h"; |
| 53 | my $Database = ($opt_b || $inn::pathtmp) . "/mailpost-msgid" ; |
| 54 | my $Maintainer = $inn::newsmaster || "usenet" ; |
| 55 | my $WhereTo = $opt_o || $Submit ; |
| 56 | my $Mailname = $inn::fromhost ; |
| 57 | |
| 58 | # can't use $inn::tmpdir as we're usually not running as news |
| 59 | my $Tmpdir = "/var/tmp" ; |
| 60 | |
| 61 | if ($debugging || $opt_n) { |
| 62 | $Sendmail = "cat" ; |
| 63 | $WhereTo = "cat" ; |
| 64 | } |
| 65 | |
| 66 | chop ($Mailname = `/bin/hostname`) if ! $Mailname ; |
| 67 | |
| 68 | |
| 69 | # |
| 70 | # our command-line argument(s) are the list of newsgroups to post to. |
| 71 | # |
| 72 | # there may be a "-r sender" or "-f sender" which becomes the $path |
| 73 | # (which is in turn overridden below by various optional headers.) |
| 74 | # |
| 75 | # -d (distribution) and -a (approved) are also supported to supply |
| 76 | # or override the mail headers by those names. |
| 77 | # |
| 78 | |
| 79 | my $path = 'nobody'; |
| 80 | my $newsgroups = undef; |
| 81 | my $approved = undef; |
| 82 | my $distribution = undef; |
| 83 | my $mailing_list = undef; |
| 84 | my $references = undef; |
| 85 | my @errorText = (); |
| 86 | |
| 87 | if ($opt_r || $opt_f) { |
| 88 | $path = $opt_r || $opt_f ; |
| 89 | push @errorText, "((path: $path))\n" ; |
| 90 | } |
| 91 | |
| 92 | if ($opt_a) { |
| 93 | $approved = &fix_sender_addr($opt_a); |
| 94 | push @errorText, "((approved: $approved))\n"; |
| 95 | } |
| 96 | |
| 97 | if ($opt_d) { |
| 98 | $distribution = $opt_d ; |
| 99 | push @errorText, "((distribution: $distribution))\n"; |
| 100 | } |
| 101 | |
| 102 | if ($opt_m) { |
| 103 | $mailing_list = "<" . $opt_m . "> /dev/null"; |
| 104 | push @errorText, "((mailing_list: $mailing_list))\n"; |
| 105 | } |
| 106 | |
| 107 | $newsgroups = join ", ", @ARGV ; |
| 108 | |
| 109 | die "usage: $0 newsgroup [newsgroup]\n" unless $newsgroups; |
| 110 | |
| 111 | |
| 112 | # |
| 113 | # do the header. our input is a mail message, with or without the From_ |
| 114 | # |
| 115 | |
| 116 | #$message_id = sprintf("<mailpost.%d.%d@%s>", time, $$, $Hostname); |
| 117 | my $real_news_hdrs = ''; |
| 118 | my $weird_mail_hdrs = ''; |
| 119 | my $fromHdr = "MAILPOST-UNKNOWN-FROM" ; |
| 120 | my $dateHdr= "MAILPOST-UNKNOWN-DATE" ; |
| 121 | my $msgIdHdr = "MAILPOST-UNKNOWN-MESSAGE-ID" ; |
| 122 | my $from = undef; |
| 123 | my $date = undef; |
| 124 | my $hdr = undef; |
| 125 | my $txt = undef; |
| 126 | my $message_id ; |
| 127 | my $subject = "(NONE)"; |
| 128 | |
| 129 | $_ = <STDIN>; |
| 130 | if (!$_) { |
| 131 | if ( $debugging || -t STDERR ) { |
| 132 | die "empty input" ; |
| 133 | } else { |
| 134 | syslog "err", "empty input" ; |
| 135 | exit (0) ; |
| 136 | } |
| 137 | } |
| 138 | |
| 139 | chomp $_; |
| 140 | |
| 141 | my $line = undef; |
| 142 | if (/^From\s+([^\s]+)\s+/) { |
| 143 | $path = $1; |
| 144 | push @errorText, "((path: $path))\n"; |
| 145 | $_ = $'; |
| 146 | if (/ remote from /) { |
| 147 | $path = $' . '!' . $path; |
| 148 | $_ = $`; |
| 149 | } |
| 150 | $date = $_; |
| 151 | } else { |
| 152 | $line = $_; |
| 153 | } |
| 154 | |
| 155 | for (;;) { |
| 156 | last if defined($line) && ($line =~ /^$/) ; |
| 157 | |
| 158 | $_ = <STDIN> ; |
| 159 | chomp ; |
| 160 | |
| 161 | # gather up a single header with possible continuation lines into $line |
| 162 | if (/^\s+/) { |
| 163 | if (! $line) { |
| 164 | $msg = "First line with leading whitespace!" ; |
| 165 | syslog "err", $msg unless -t STDERR ; |
| 166 | die "$msg\n" ; |
| 167 | } |
| 168 | |
| 169 | $line .= "\n" . $_ ; |
| 170 | next ; |
| 171 | } |
| 172 | |
| 173 | # On the first header $line will be undefined. |
| 174 | ($_, $line) = ($line, $_) ; # swap $line and $_ ; |
| 175 | |
| 176 | last if defined($_) && /^$/ ; |
| 177 | next if /^$/ ; # only on first header will this happen |
| 178 | |
| 179 | push @errorText, "($_)\n"; |
| 180 | |
| 181 | next if /^Approved:\s/sio && defined($approved); |
| 182 | next if /^Distribution:\s/sio && defined($distribution); |
| 183 | |
| 184 | if (/^(Organization|Distribution):\s*/sio) { |
| 185 | $real_news_hdrs .= "$_\n"; |
| 186 | next; |
| 187 | } |
| 188 | |
| 189 | if (/^Subject:\s*/sio) { |
| 190 | $subject = $'; |
| 191 | next; |
| 192 | } |
| 193 | |
| 194 | if (/^Message-ID:\s*/sio) { |
| 195 | $message_id = $'; |
| 196 | next; |
| 197 | } |
| 198 | |
| 199 | if (/^Mailing-List:\s*/sio) { |
| 200 | $mailing_list = $'; |
| 201 | next; |
| 202 | } |
| 203 | |
| 204 | if (/^(Sender|Approved):\s*/sio) { |
| 205 | $real_news_hdrs .= "$&" . fix_sender_addr($') . "\n"; |
| 206 | next; |
| 207 | } |
| 208 | |
| 209 | if (/^Return-Path:\s*/sio) { |
| 210 | $path = $'; |
| 211 | $path = $1 if ($path =~ /\<([^\>]*)\>/); |
| 212 | push@errorText, "((path: $path))\n"; |
| 213 | next; |
| 214 | } |
| 215 | |
| 216 | if (/^Date:\s*/sio) { |
| 217 | $date = $'; |
| 218 | next; |
| 219 | } |
| 220 | |
| 221 | if (/^From:\s*/sio) { |
| 222 | $from = &fix_sender_addr($'); |
| 223 | next; |
| 224 | } |
| 225 | |
| 226 | if (/^References:\s*/sio) { |
| 227 | $references = $'; |
| 228 | next; |
| 229 | } |
| 230 | |
| 231 | if (!defined($references) && /^In-Reply-To:[^\<]*\<([^\>]+)\>/sio) { |
| 232 | $references = "<$1>"; |
| 233 | # FALLTHROUGH |
| 234 | } |
| 235 | |
| 236 | if (/^(MIME|Content)-[^:]+:\s*/sio) { |
| 237 | $real_news_hdrs .= $_ . "\n" ; |
| 238 | next ; |
| 239 | } |
| 240 | |
| 241 | # strip out news trace headers since otherwise posting may fail. other |
| 242 | # trace headers will be renamed to add 'X-' so we don't have to worry |
| 243 | # about them. |
| 244 | if (/^X-(Trace|Complaints-To):\s*/sio) { |
| 245 | next ; |
| 246 | } |
| 247 | |
| 248 | # strip out Received headers since otherwise posting may fail |
| 249 | # due to too large header size. |
| 250 | if (/^(Received):\s*/sio) { |
| 251 | next ; |
| 252 | } |
| 253 | |
| 254 | # random unknown header. prepend 'X-' if it's not already there. |
| 255 | $_ = "X-$_" unless /^X-/sio ; |
| 256 | $weird_mail_hdrs .= "$_\n"; |
| 257 | } |
| 258 | |
| 259 | |
| 260 | $msgIdHdr = $message_id if $message_id ; |
| 261 | $fromHdr = $from if $from ; |
| 262 | $dateHdr = $date if $date ; |
| 263 | |
| 264 | if ($path !~ /\!/) { |
| 265 | $path = "$'!$`" if ($path =~ /\@/); |
| 266 | } |
| 267 | |
| 268 | $real_news_hdrs .= "Subject: ${subject}\n"; |
| 269 | $real_news_hdrs .= "Message-ID: ${msgIdHdr}\n" if defined($message_id); |
| 270 | $real_news_hdrs .= "Mailing-List: ${mailing_list}\n" if defined($mailing_list); |
| 271 | $real_news_hdrs .= "Distribution: ${distribution}\n" if defined($distribution); |
| 272 | $real_news_hdrs .= "Approved: ${approved}\n" if defined($approved); |
| 273 | $real_news_hdrs .= "References: ${references}\n" if defined($references); |
| 274 | |
| 275 | # Remove duplicate headers. |
| 276 | my %headers = (); |
| 277 | $real_news_hdrs =~ s/(.*?:)[ \t].*?($|\n)([ \t]+.*?($|\n))*/$headers{lc$1}++?"":$&/ge; |
| 278 | |
| 279 | # Inews writes error messages to stdout. We want to capture those and mail |
| 280 | # them back to the newsmaster. Trying to write and read from a subprocess is |
| 281 | # ugly and prone to deadlock, so we use a temp file. |
| 282 | $tmpfile = sprintf "%s/mailpost.%d.%d", $Tmpdir, time, $$ ; |
| 283 | |
| 284 | if (!open TMPFILE,">$tmpfile") { |
| 285 | $msg = "cant open temp file ($tmpfile): $!" ; |
| 286 | $tmpfile = undef ; |
| 287 | syslog "err", "$msg\n" unless $debugging || -t STDERR ; |
| 288 | open TMPFILE, "|" . sprintf ($Sendmail, $Maintainer) || |
| 289 | die "die(no tmpfile): sendmail: $!\n" ; |
| 290 | print TMPFILE <<"EOF"; |
| 291 | To: $Maintainer |
| 292 | Subject: mailpost failure ($newsgroups): $msg |
| 293 | |
| 294 | -------- Article Contents |
| 295 | |
| 296 | EOF |
| 297 | } |
| 298 | |
| 299 | print TMPFILE <<"EOF"; |
| 300 | Path: ${path} |
| 301 | From: ${fromHdr} |
| 302 | Newsgroups: ${newsgroups} |
| 303 | ${real_news_hdrs}Date: ${dateHdr} |
| 304 | ${weird_mail_hdrs} |
| 305 | EOF |
| 306 | |
| 307 | my $rest; |
| 308 | $rest .= $_ while (<STDIN>); |
| 309 | $rest =~ s/\n*$/\n/g; # Remove trailing \n except very last |
| 310 | |
| 311 | print TMPFILE $rest; |
| 312 | close TMPFILE ; |
| 313 | |
| 314 | if ( ! $tmpfile ) { |
| 315 | # we had to bail and mail the article to the admin. |
| 316 | exit (0) ; |
| 317 | } |
| 318 | |
| 319 | |
| 320 | ## |
| 321 | ## We've got the article in a temp file and now we validate some of the |
| 322 | ## data we found and update our message-id database. |
| 323 | ## |
| 324 | |
| 325 | mailArtAndDie ("no From: found") unless $from; |
| 326 | mailArtAndDie ("no Date: found") unless $date; |
| 327 | mailArtAndDie ("no Message-ID: found") unless $message_id; |
| 328 | mailArtAndDie ("Malformed message ID ($message_id)") |
| 329 | if ($message_id !~ /\<(\S+)\@(\S+)\>/); |
| 330 | |
| 331 | |
| 332 | # update (with locking) our message-id database. this is used to make sure we |
| 333 | # don't loop our own gatewayed articles back through the mailing list. |
| 334 | |
| 335 | my ($lhs, $rhs) = ($1, $2); # of message_id match above. |
| 336 | $rhs =~ tr/A-Z/a-z/; |
| 337 | |
| 338 | $message_id = "${lhs}\@${rhs}"; |
| 339 | |
| 340 | push @errorText, "(TAS message-id database for $message_id)\n"; |
| 341 | |
| 342 | my $lockfile = sprintf("%s.lock", $Database); |
| 343 | |
| 344 | open LOCKFILE, "<$lockfile" || |
| 345 | open LOCKFILE, ">$lockfile" || |
| 346 | mailArtAndDie ("can't open $lockfile: $!") ; |
| 347 | |
| 348 | my $i ; |
| 349 | for ($i = 0 ; $i < 5 ; $i++) { |
| 350 | flock LOCKFILE, $LOCK_EX && last ; |
| 351 | sleep 1 ; |
| 352 | } |
| 353 | |
| 354 | mailArtAndDie ("can't lock $lockfile: $!") if ($i == 5) ; |
| 355 | |
| 356 | my %DATABASE ; |
| 357 | dbmopen %DATABASE, $Database, 0666 || mailArtAndDie ("can't dbmopen $lockfile: $!"); |
| 358 | |
| 359 | exit 0 if defined $DATABASE{$message_id}; # already seen. |
| 360 | |
| 361 | $DATABASE{$message_id} = sprintf "%d.%s", time, 'mailpost' ; |
| 362 | |
| 363 | mailArtAndDie ("TAS didn't set $message_id") unless defined $DATABASE{$message_id}; |
| 364 | |
| 365 | dbmclose %DATABASE || mailArtAndDie ("can't dbmclose $lockfile: $!") ; |
| 366 | |
| 367 | flock LOCKFILE, $LOCK_UN || mailArtAndDie ("can't unlock $lockfile: $!"); |
| 368 | close LOCKFILE ; |
| 369 | |
| 370 | if (!open INEWS, "$WhereTo < $tmpfile 2>&1 |") { |
| 371 | mailArtAndDie ("cant start: $WhereTo: $!") ; |
| 372 | } |
| 373 | |
| 374 | my @inews = <INEWS> ; |
| 375 | close INEWS ; |
| 376 | my $status = $? ; |
| 377 | |
| 378 | if (@inews) { |
| 379 | chomp @inews ; |
| 380 | mailArtAndDie ("inews failed: @inews") ; |
| 381 | } |
| 382 | |
| 383 | unlink $tmpfile ; |
| 384 | |
| 385 | exit $status; |
| 386 | |
| 387 | sub mailArtAndDie { |
| 388 | my ($msg) = @_ ; |
| 389 | |
| 390 | print STDERR $msg,"\n" if -t STDERR ; |
| 391 | |
| 392 | open SENDMAIL, "|" . sprintf ($Sendmail,$Maintainer) || |
| 393 | die "die($msg): sendmail: $!\n" ; |
| 394 | print SENDMAIL <<"EOF" ; |
| 395 | To: $Maintainer |
| 396 | Subject: mailpost failure ($newsgroups): $msg |
| 397 | |
| 398 | $msg |
| 399 | EOF |
| 400 | |
| 401 | if ($tmpfile && -f $tmpfile) { |
| 402 | print SENDMAIL "\n-------- Article Contents\n\n" ; |
| 403 | open FILE, "<$tmpfile" || die "open($tmpfile): $!\n" ; |
| 404 | print SENDMAIL while <FILE> ; |
| 405 | close FILE ; |
| 406 | } else { |
| 407 | print "No article left to send back.\n" ; |
| 408 | } |
| 409 | close SENDMAIL ; |
| 410 | |
| 411 | # unlink $tmpfile ; |
| 412 | |
| 413 | exit (0) ; # using a non-zero exit may cause problems. |
| 414 | } |
| 415 | |
| 416 | |
| 417 | # |
| 418 | # take 822-format name (either "comment <addr> comment" or "addr (comment)") |
| 419 | # and return in always-qualified 974-format ("addr (comment)"). |
| 420 | # |
| 421 | sub fix_sender_addr { |
| 422 | my ($address) = @_; |
| 423 | my ($lcomment, $addr, $rcomment, $comment); |
| 424 | local ($',$`,$_) ; |
| 425 | |
| 426 | if ($address =~ /\<([^\>]*)\>/) { |
| 427 | ($lcomment, $addr, $rcomment) = (&dltb($`), &dltb($1), &dltb($')); |
| 428 | } elsif ($address =~ /\(([^\)]*)\)/) { |
| 429 | ($lcomment, $addr, $rcomment) = ('', &dltb($`.$'), &dltb($1)); |
| 430 | } else { |
| 431 | ($lcomment, $addr, $rcomment) = ('', &dltb($address), ''); |
| 432 | } |
| 433 | |
| 434 | #print STDERR "fix_sender_addr($address) == ($lcomment, $addr, $rcomment)\n"; |
| 435 | |
| 436 | $addr .= "\@$Mailname" unless ($addr =~ /\@/); |
| 437 | |
| 438 | if ($lcomment && $rcomment) { |
| 439 | $comment = $lcomment . ' ' . $rcomment; |
| 440 | } else { |
| 441 | $comment = $lcomment . $rcomment; |
| 442 | } |
| 443 | |
| 444 | $_ = $addr; |
| 445 | $_ .= " ($comment)" if $comment; |
| 446 | |
| 447 | #print STDERR "\t-> $_\n"; |
| 448 | |
| 449 | return $_; |
| 450 | } |
| 451 | |
| 452 | # |
| 453 | # delete leading and trailing blanks |
| 454 | # |
| 455 | |
| 456 | sub dltb { |
| 457 | my ($str) = @_; |
| 458 | |
| 459 | $str =~ s/^\s+//o; |
| 460 | $str =~ s/\s+$//o; |
| 461 | |
| 462 | return $str; |
| 463 | } |
| 464 | |