A.1 A Mail-to-News Gateway

This is my batch news gateway, run every five minutes from cron. The incoming messages to the gateway are stored in a Maildir ~alias/newsdir, using a virtual domain setup that sends mail to the pseudo-domains news and news.example.com to alias-news, which is delivered by ~alias/.qmail-news-default.

My news gateway handles news from multiple hosts on my network by the simple trick of symlinking newsdir, which is exported over the LAN by NFS, into ~alias on each host, so that all the hosts store messages into the same directory. I find this easier and faster than running a copy of the gateway on each host.

The script run from cron uses maildirserial to select mail messages, and tcpclient to open an NNTP connection to the local news server, as shown in Example A-1.

Example A-1. Script called from cron to push out news

#!/bin/sh exec setlock newsdir.lock \     maildirserial -b -t 345600 newsdir alias-news- \         tcpclient localhost 119 \                 /var/qmail/alias/newsgate alias-news-

The actual mail to news script is fairly long, but nearly all of it is devoted to cleaning up headers, as shown in Example A-2.

Example A-2. Mail to news gateway script

#!/usr/bin/perl # -*- perl -*- # process batched messages from maildirserial into news use Getopt::Std; use FileHandle; # options # -d  debug, use tty for I/O # -s  don't use date from incoming messages #     to avoid complaints about stale news getopts('ds'); $linelimit = 2000; # truncate long msgs after this many lines $| = 1; # get prefix to strip off Delivered-To: $prefix = shift or die "need prefix"; # read null terminated input for file names msgloop: while(!eof STDIN) {     my ($from, $sender, $replyto);     {         local $/ = "\0";         $fn = <STDIN>;         chop $fn;     }     open(MSG, $fn) or die "cannot open '$fn'\n";     if(<MSG> =~ m{Return-Path: <(.*)>}) {         $sender = $1;     } else {         close MSG;         print "$fn\0Dno sender address\n";         next;     }     # invent fake sender since news forbids null return addrs     $sender = "MAILER-DAEMON\@somewhere.local" if $sender eq "";     if(<MSG> =~ m{Delivered-To: $prefix(.*)}) {         $recip = $1;     } else {         close MSG;         print "$fn\0Dno recipient address\n";         next;     }     my $approve = 0;     my $nobounce = 0;     my ($newrecip, $domain) = ($recip =~ m{(.*)\@(.*)}); # dump domain     # make sure sent to something@news to prevent     #  outside mail from sneaking in     if($domain =~ /^news/) {                 $recip = $newrecip;     } else {         print "$fn\0DYou cannot send mail to this address.\n";         close MSG;         next;     }     $newsgroups = lc $recip;     # pick off approve- and nobounce- prefixes     while(1) {         if($newsgroups =~ /^approve-(.*)/) {             $newsgroups = $1;             $approve = 1;         } elsif($newsgroups =~ /^nobounce-(.*)/) {             $newsgroups = $1;             $nobounce = 1;         } else {             last;         }     } # slurp up the header and regularize some of the lines     my @headers = ( );     $from = "";     while(<MSG>) {         last if /^$/;                  chomp;         # skip blank subject         next if /^Subject:\s*$/;         if(/^From:/io) {             s/ MAILER-DAEMON / MAILER-DAEMON\@somewhere.local /;             s/<MAILER-DAEMON>/<MAILER-DAEMON\@somewhere.local>/;             s/<>/<MAILER-DAEMON\@somewhere.local>/;             s/:\s*\(\)/: <MAILER-DAEMON\@somewhere.local>/;             s/<postmaster>/<postmaster\@somewhere.local>/;         }         if(/^\s/) {             s/^\s+//;             $_ =  pop(@headers) . " " . $_;             push @headers, $_;         } else {             s/:(\S)/: $1/;                # force a space after the colon             push @headers, $_;         }         $subject = $1 if /^Subject: *(.*)/ois;         print STDERR "found subject $subject\n" if /^Subject: *(.*)/ois;         $from = $1 if /^From: +(.*)/ois;         $replyto = $1 if /^Reply-To: +(.*)/ois;         $sender = $1 if /^Sender: +(.*)/ois;     } # figure out who it's from     $from = $replyto if $replyto;     $from = $sender unless $from;     $from =~ s/\s+$//;     $subject =~ s/\s+$//; # now strip out the crud     if( $from =~ /<(.*)>/s) {         $from = $1;     } else {         $from =~ s'\s*\([^)]*\)\s*''sg; # strip comments     } # check for bogus addresses     unless ( $from =~ m/.*\@.*\.[a-z]{2,8}$/io ) {         print "$fn\0ZInvalid return address '$from', discarded\n";         close MSG;         next msgloop;     }     # start up an NNRP session on open tcp socket     startnews( ); # tell news server we're going to post something     print NOUT "post\r\n";     $l = <NIN>;     $l =~ s/\r?\n$//;     unless($l =~ /^340 /) {         print "$fn\0ZCannot post $l\n";         close MSG;         next;     } # now send the nessage headers, cleaning up as we go     print NOUT "Newsgroups: $newsgroups\r\n";     print NOUT "Approved: news-to-mail\r\n" if $approve;     unless($subject) {         print NOUT "Subject: (no subject)\r\n";     }     $didmsgid = 0;     $diddate = 0;     $didcte = 0;     $didmv = 0;     $diddate = 0;     $didsubject = 0;     $didreply = 0;     $didfrom = 0;     $didref = 0;     $didcc = 0;     $didto = 0;     foreach $_ (@headers) {         next if /^(Newsgroups|Sender|Status|Received|Approved|nntp\S+):/io;         next if /^(Via|X-Mailer|Path|Return-Path|Distribution|X-Status|Xref):/io;         next if /^(Apparently-To|X-Trace|X-Complaints-To):/io;              # inews freaks on long headers         $_ = substr($_, 0, 500) if length($_) > 500;     # really freaks on long references         # lose blank subject         next if m/^Subject:\s*$/io;         # some headers can only appear once         next if m/^date:/io && $diddate++;         next if m/^Content-Transfer-Encoding:/io && $didcte++;         next if m/^Mime-Version:/io && $didmv++;         next if m/^Date:/io && $diddate++;         next if m/^Subject:/io && $didsubject++;         next if m/^From:/io && $didfrom++;         next if m/^Reply-To:/io && $didreply++;         next if m/^References:/io && $didref++;         if(m/^Cc:/io) {             print NOUT "X-" if $didcc++;         }         if(m/^To:/io) {             print NOUT "X-" if $didto++;         }     # turn Date: into X-Date: if -s         print NOUT "X-" if $opt_s and /^(Date):/io ;         print NOUT "X-Old-" if /^(Sender|x-complaints):/io ;     # only one message ID, and it has to be a good one         if(/^Message-ID:/io) {             # if bad msgid, let it gen a new one             next unless /^Message-ID: +<(.*@[^@ ]+)>$/io;             next if $didmsgid;             $didmsgid = 1;         }         print NOUT "$_\r\n";     }     print NOUT "From: $sender\r\n" unless $didfrom;     print NOUT "Subject: [probably spam, from $sender]\r\n" unless $didsubject; # end of header     print NOUT "\r\n";                             my $didbody = 0; # copy the body, split overlong lines     my $linecount = 0;     while(<MSG>) {         if(++$linecount > $linelimit) {             print NOUT "\r\n[ message too long, truncated ]\r\n";             last;         }         chomp;         s/^\./../;         while(m/^(.{500})(.+)$/) {             print NOUT "$1\r\n";             $_ = "+ $2";         }         print NOUT "$_\r\n";         $didbody++;     }     print NOUT "[empty message]\r\n" unless $didbody;     close MSG; # end of message, see if the server liked it and report back     print NOUT ".\r\n";     $l = <NIN>;     $l =~ s/\r?\n$//;     if($l =~ /^240 /) {         print "$fn\0Kposted to $newsgroups\n";     } elsif($nobounce) {         print "$fn\0Kfailed to $newsgroups (ignored) $l\n";     } elsif($l =~ /^441 435 /) {         print "$fn\0D$l\n";        # perm fail, duplicate     } else {         print "$fn\0Z$l\n";        # temp fail, anything else     } # done with this message } # end news session stopnews( ); exit 0; ################################################################ sub startnews {     my ($fn) = $_;     my $l;     return if $newsstarted;     if($opt_d) {         open(NIN, "</dev/tty");         open(NOUT, ">/dev/tty");     } else {         open(NIN, "<&=6");         open(NOUT, ">&=7");     }     autoflush NOUT 1;     # wait for prompt     $l = <NIN>;     $l =~ s/\r?\n$//;     unless( $l =~ /^200 /) {         print "$fn\0Z$l\n";         exit;     }     print NOUT "mode reader\r\n";     $l = <NIN>;     $l =~ s/\r?\n$//;     unless( $l =~ /^200 /) {         print "$fn\0Z$l\n";         exit;     }          $newsstarted = 1; } sub stopnews {     return unless $newsstarted;     print NOUT "quit\r\n"; }