#!/usr/local/bin/perl -T
# $Revision: 1.142 $
#
# 1.142: MTS: documented code a little better
# 1.141: MTS: increased timeouts for NNTP connections
# 1.140: MTS: sendmail messages are queued instead of being sent right back
# 	 most of the messages sent out are not time sensitive, such as
# 	 moderated messages and bounced messages, because we don't want to 
# 	 waste cycles on things that could be sent later
# 1.139: MTS: Tainted perl used
# 	 BASH_ENV and PATH set to something safe
# 	 Changes made to concurrency run filter sub routines to make 
# 	 possible to run multipost with taint turned on
#
#	TODO:	1) binary filtering subroutine
#			a) filter out known newsgroups that do not
#			   allow binaries
#			b) add in ability to define a news server as
#			   not allowing binaries
#		2) add ability to define port value for news servers
#
# Authors:  Original Author:
#
# 	    Other Authors:
# 	    MTS:  Michael T. Shinn <mike@shinn.net>
#
# To use multipost, a recommended way to launch it is either from .forward
# or .procmailrc.  The prefered method is .procmailrc, to allow for
# any needed filters, etc. before invoking multipost, which can have
# alot of overhead.
#
# for .forward
# |/usr/mail2news/multipost -F'/usr/mail2news/dupdetect /usr/mail2news/dupdb'
#
# for procmail:
# :0
# |/home/gateway/multipost.sh 
#
# and your shellscript will look like this:
# #!/bin/sh
# /bin/nice -n 19 /usr/mail2news/multipost -F'/usr/mail2news/dupdetect \
# /usr/mail2news/dupdb' 2>> /usr/mail2news/tmp/multipost_errors
#
# Or however you want to launch multipost 
#
# redirecting stderr to a file is recommeneded in case you have any
# errors in execution, and also to prevent any error message from
# being bounced back to a user, attacker, etc.

require 5.004;

BEGIN {
        $ENV{PATH}      = "/bin";
        $ENV{BASH_ENV}  = "";
}

use strict;
use Socket;
use IO::Handle;
use POSIX qw(:fcntl_h strftime);
use Getopt::Std;
use DB_File;
require "errno.ph";
require "sys/syscall.ph";
#require "sysexits.ph";

#my $LOCALNAME = 'mixmaster.shinn.net';       		# Machine name to put in headers
my $LOCALNAME = 'freedom.gmsociety.org';       		# Machine name to put in headers
my $LOCALADDR = '209.70.109.122';    			# Local address to bind to for NNTP
my $MAILADDR = 'usenet-gateway';            		# This address "$MAILADDR\@$LOCALNAME"
#my $COMPLAINTS = 'mail2news-abuse@mixmaster.shinn.net'; # contact header
my $COMPLAINTS = 'mail2news-abuse@freedom.gmsociety.org'; # contact header
my $QMAIL_CODES = 0; 					# Set to 1 to use qmail rather than sendmail exit codes
my $MODBOUNCE = "$MAILADDR-moderator-return\@$LOCALNAME";

# List of servers.  For each server, method is either 'ihave' for
# transfer (better) or 'post' if you only have nnrp privileges.
# Third variable is the port to talk to on that host
# Fourth variable is to allow or not allow binary posts 1=yes 0=no
# Fifth variable is maximum message size in KB for that server 0=no limit
my @SERVERS = (
              'newsin.alt.net', 'ihave', #'119', '1', '0',    	#Chris Caputo <ccaputo@alt.net>
              #'ns2.2rad.net', 'post', #'119', '1', '0',
              'domino.2rad.net', 'post', #'119', '1', '0',
              #'domino.2rad.net', 'ihave', #'119', '1', '0',
              #'news.peregrinehw.com', 'post', #'119', '1', '0',
#
# This news server does not allow binaries, so we need to figure out a
# way to filter out binaries so they don't get sent to this
# server, which would probably also be useful for filtering on certain
# newsgroups as well
#
              'news.itconsult.net', 'ihave', #'119', '0', '250'   # matthew@itconsult.co.uk
	      'shinn.peers.tele.dk', 'ihave', #'433', '1', '0',  #usenet@tdk.net
#
# Older servers
#              'news.shinn.net', 'post',
#              'news.2rad.net', 'post'
#
               );

my $LIBDIR = "/usr/mail2news/lib";
my $LOGDIR = "/usr/mail2news/tmp";
my $NICE = "/bin/nice"; 
my $SENDMAIL = "/usr/sbin/sendmail"; 
#my $CLDIR;      # Directory for concurrency lock
my $CLDIR = "$LIBDIR/mail2news-lock";   #primitive, but effective concurrency control
					#create files in this directory, number 1 thru N
					#for the number of concurrent multiposts you want
					#to run.  For instance, if you touch 1, 2, 3, 4
					#in CLDIR, only 4 instances of multipost will be allowed to run

my $BLOCK = "$LIBDIR/source.block";         # From: addresses to block
my $HELPMSG = "$LIBDIR/mail2news-help.msg"; # Long help message
my $BOUNCEMSG = "$LIBDIR/post-bounce.msg";  # Short help for every bounce
my $LOGFILE = "$LOGDIR/post.log";           # Synopsis of posted/rejected mail
my $LOGGOOD = "$LOGDIR/post.ok";            # Logged posted articles
my $LOGBAD = "$LOGDIR/post.err";            # Logged rejected articles

my $MSGIDDB = "$LIBDIR/msgid.db";           # Message ID's of posted articles
my $GROUPDB = "$LIBDIR/groups.db";

my $FIRSTFROM = 1;     # Take the first "From" header as opposed to the last
			#This helps prevent spoofs

# Organization header to add
#my $ORGANIZATION = "mail2news\@mixmaster.shinn.net";
my $ORGANIZATION = "mail2news\@freedom.gmsociety.org";
my $WARNHDR = <<"EOF";                      # Full disclaimer header(s)
X-Warning: Sender address is unverified and may not be authentic.
X-Warning: The address shown in the From header, if any, is unverified and maybe wrong.
X-Warning: The original sender is unlogged and unknown.  
EOF
my $LOOPHDR = "X-Loop: $MAILADDR\@$LOCALNAME\n"; # Added to detect loops

my $CANCELDAYS = 7;

sub LOCK_SH {0x01;}
sub LOCK_EX {0x02;}
sub LOCK_NB {0x04;}
sub LOCK_UN {0x08;}

#
#  Return the E-mail address of a moderator for a particular newsgroup,
#  or "nobody" if no moderator address is found.
#
sub moderator {
    my $group;
    unless ($_[0] =~ /^\s*([a-zA-Z][\w.+-]*)\s*$/) {
        print STDERR "No moderator for bad group name $_[0]\n";
        return undef;
    }
    $group = $1;
    $group =~ s/\./-/g;
    if ($group =~ /^gnu-/) {
        return "$group\@tut.cis.ohio-state.edu";
    }
    elsif ($group =~
           /^(alt|biz|comp|misc|news|rec|sci|soc|talk|humanities)-/) {
        return "$group\@news.uu.net";
    }
    else {
        return undef;
    }
}

delete $ENV{'IFS'};
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';
$ENV{'SHELL'} = '/bin/sh';
$SIG{'INT'} = \&handler;
$SIG{'TERM'} = \&handler;

my @sockets;
my @tmpfiles;
my $tmpfileno = 0;
my $receiving_mail;
my %gdb;
my %bdb;
my $lre;

my $loginfo;
#my $nservers = int (@SERVERS / 5);
my $nservers = int (@SERVERS / 2);
my $nok = 0;
my $nagain = 0;
my $nrej = 0;
my $nopen;
my ($rin, $win) = ('', '');
my ($myaddr, $bindsin, $nntpport, $errors);
my $headers;
my $crosspostidx;
my $firsttime;

sub leave {
    my $exitcode = shift;
    unlink (@tmpfiles) if (@tmpfiles);
    if ($QMAIL_CODES) {
        if ($exitcode == 71 || $exitcode == 74 || $exitcode == 75) {
            $exitcode = 111;
        }
        elsif ($exitcode) {
            $exitcode = 100;
        }
    }
    exit ($exitcode);
}
sub handler {
    &leave (75);
}
sub catfile {
    local (*MSG);
    if (open MSG, "<" . $_[0]) {
        while (<MSG>) {print;}
        close (MSG);
    }
}
sub fatal {
    select (STDOUT);
    print $_[1];
    catfile $BOUNCEMSG if ($receiving_mail);
    &leave ($_[0]);
}

my $__check_concurrency_fh;
sub check_concurrency ($) {
    local (*D);
    my $dir = shift;
    my $fh = new IO::Handle;
    my $f;
    local $1;
    opendir (D, $dir) || die "$dir is not a directory";
    while (defined ($f = readdir D)) {
	unless ($f =~ m#^(\d+)$#) {
		next if $f eq "." or $f eq "..";
		&writelog ("\nSECURITY WARNING: filename '$f' has untrusted characters in concurrency subroutine\n");
		die "filename '$f' has untrusted characters\n";
		$f = $1;
	}
	$f = $1;
        next unless -f "$dir/$1";
        if (open ($fh, ">>$dir/$1")) {
            if (flock ($fh, (&LOCK_EX | &LOCK_NB))) {
                $__check_concurrency_fh = $fh;
                return;
            }
            close $fh;
        }
    }
    closedir D;
    &writelog ("\nCONCHECK: Concurrency limit reached.  Post not sent.\n");
    fatal (75, "concurrency limit reached\n");
}


my @BINCHARS = ('-', '0' .. '9', 'A' .. 'Z', '_', 'a' .. 'z');
sub armor3bytes {
    my ($val) = @_;
    my $str = "";
    my $i;
    for ($i = 0; $i < 4; $i++) {
        $str .= $BINCHARS[$val&0x3f];
        $val >>= 6;
    }
    return $str;
}
sub mkmsgid {
    my $tv = pack ("x16");
    syscall (&SYS_gettimeofday, $tv, undef);
    my ($sec, $usec) = unpack ("L2", $tv);
    my $id = $BINCHARS[($usec>>6) & 0x3f] . $BINCHARS[$usec & 0x3f];
    foreach ($sec, (($sec >> 24) & 0x7f) | ($$ << 8)) {
        $id .= &armor3bytes ($_);
    }
    return "<mn.$id\@$LOCALNAME>";
}
sub rfc822date {
    strftime ("%a, %d %b %Y %H:%M:%S +0000 (GMT)", gmtime (time));
}

sub flock_db (\%$) {
    my ($href, $flags) = @_;
    local (*DB_FH);
    my $db = tied %$href;

    $db || fatal (70, "Couldn't get DB object.\n");
    $db->sync;
    open (DB_FH, "+<&" . $db->fd) || die "dup: $!";
    flock (DB_FH, $flags) || fatal (70, "Couldn't flock database: $!.\n");
}
sub tie_lock (\%$;$) {
    my ($href, $path, $flags) = @_;
    my $db;
    local (*DB_FH);

    tie (%$href, "DB_File", "$path", O_CREAT|O_RDWR, 0660, $DB_HASH)
        || fatal (75, "Couldn't open database: $!.\n");
    $flags = &LOCK_EX unless defined $flags;
    flock_db (%$href, $flags) if $flags;
}
sub untie_unlock (\%) {
    my ($href) = @_;
    flock_db (%$href, &LOCK_UN ());
    untie %$href;
}

sub tmpfile (\*;$) {
    my ($file, $path) = @_;
    my $fd;

    unless ($path) {
        $path = "/tmp/TMP.$$.$tmpfileno";
        $tmpfileno++;
    }
    push @tmpfiles, $path;

    unlink ($path);
    ($fd = POSIX::open($path, O_CREAT|O_RDWR|O_EXCL, 0660))
        || die "$path: $!";
    open $file, "+>&=$fd";
    return 1;
}

sub parse_address {
    $_ = $_[0];
    /^.*<(\S*)>/ && return $1;
    /^(\S+:)?\s*([^\s,]+)/ && return $2;
    undef;
}
sub replypipe {
    my $fh = shift;
    my $prio = 0;
    my $sender;
    my $msgid;

    foreach (@_) {
        if (/^Message-Id:\s*(<\S+>)/) {
            $msgid = $1;
        }
        elsif (/MAILER-DAEMON/) {
            return undef;
        }
        elsif (/^From\s+(\S+)/ && $prio < 1) {
            $prio = 1; $sender = $1;
        }
        elsif (/^From:/ && $prio <= 2) {
            $prio = 2;
            $sender = &parse_address ($_);
        }
        elsif (/^Reply-To:/) {
            $prio = 3;
            $sender = &parse_address ($_);
        }
    }
    return undef unless ($sender);
    &fatal (70, "Opening pipe to sendmail failed.\n")
        unless (open $fh, "|$NICE -n 20 $SENDMAIL -odq -oi -f usenet-gateway\@$LOCALNAME -t");
        #unless (open $fh, "|$SENDMAIL -oi -f anmetet\@$LOCALNAME -t");
    print $fh "To: $sender\n";
    print $fh "References: $msgid\nIn-Reply-To: $msgid\n" if ($msgid);
    print $fh "From: $MAILADDR autoreply <usenet-gateway\@$LOCALNAME>\n";
    print $fh $LOOPHDR;
    return 1;
}

sub savearticle {
    my $file = shift;
    local (*LOG);
    if (open (LOG, ">>$file") && flock (LOG, &LOCK_EX)) {
        print LOG "$headers\n";
        seek (ARTICLE, 0,0);
        while (<ARTICLE>) {last if /^\r?$/;}
        while (<ARTICLE>) {
            if (/^\.\r?$/) {
                print LOG "\n";
                last;
            }
            print LOG $_;
        }
        close LOG;
    }
}
sub writelog {
    local (*LOG);
    if (open (LOG, ">>$LOGFILE") && flock (LOG, &LOCK_EX)) {
        print LOG @_;
        close LOG;
    }
}

sub runfilter ($) {
    my $cmd = shift;
    seek (ARTICLE, 0, 0);
    my $pid = open (FILTEROUT, "-|");
    &fatal (71, "Fork failed.\n") unless defined $pid;
    unless ($pid) {
	#&writelog ("\nFILTER: Running duplicate checker...\n");
        open (STDIN, "<&ARTICLE");
        open (STDOUT, ">&FILTEROUT");
        open (STDERR, ">&FILTEROUT");
        unless (exec ($cmd)) { print "exec: $!\n"; exit (71); }
    }

    my $res = '';
    while (<FILTEROUT>) { $res .= $_; }
    close (FILTEROUT);

    my $exitcode = 0;
    my $rc = $? & 0xffff;
    if ($rc) {
        if ($rc & 0xff) {
            $res .= "filter received signal\n";
            $exitcode = 71;
        }
        else {
            $res = "filter failure\n" if (!$res);
            $exitcode = $rc >> 8;
        }
    }

    return ($res, $exitcode);
}

sub confree {
    my $fd = shift;
    my $ss = $sockets[$fd];
    if (defined ($_[0])) {
        my $msg = sprintf ($_[0], @_[1..$#_]);
        chomp ($msg);
        $msg =~ s/\r//;
        $errors .= sprintf "%24s:  %s\n", $ss->{SERVER}, $msg;
    }
    vec ($rin, $fd, 1) = 0;
    vec ($win, $fd, 1) = 0;
    close ($ss->{FH});
    $nopen--;
    undef $sockets[$fd];
}

sub recvline_cb {
    my ($fd) = @_;
    my $ss = $sockets[$fd];
    my $fh = $ss->{FH};
    my @lines;

    if ($$ss{RBUF} !~ /\n/) {
        unless (sysread ($fh, $$ss{RBUF}, 4096, length $$ss{RBUF})) {
            $nagain++;
            confree ($fd, "premature EOF");
            return;
        }
    }
    @lines = split (/\n/, $$ss{RBUF}, -1);
    $$ss{RBUF} = pop @lines;
    foreach (@lines) {
        vec ($rin, $fd, 1) = 0;
        $_ .= "\n";
        print STDERR $$ss{SERVER}, " >> ", $_ if ($Getopt::Std::opt_d);
        &{$ss->{RARG}} ($fd, $_);
        last unless (vec ($rin, $fd, 1));
    }
}

sub recvline {
    my ($fd, $cb) = @_;
    my $ss = $sockets[$fd];
    vec ($rin, $fd, 1) = 1;
    $ss->{RCB} = \&recvline_cb;
    $ss->{RARG} = $cb;
}

sub senddata_cb {
    my ($fd) = @_;
    my $ss = $sockets[$fd];
    my $fh = $ss->{FH};
    my $len;

    unless ($len = syswrite ($fh, $$ss{WBUF},
                             length ($$ss{WBUF}) - $$ss{POS},
                             $$ss{POS})) {
        $nagain++;
        confree ($fd, "write error: $!");
        return;
    }
    $$ss{POS} += $len;
    if ($$ss{POS} >= length $$ss{WBUF}) {
        $$ss{WBUF} = '';
        $$ss{POS} = 0;
        vec ($win, $fd, 1) = 0;
        &{$$ss{WARG}} ($fd) if ($$ss{WARG});
    }
}

sub senddata {
    my ($fd, $data, $cb) = @_;
    my $ss = $sockets[$fd];
    print STDERR $ss->{SERVER}, " << ", $data if ($Getopt::Std::opt_d);
    unless ($data) {&$cb ($fd); return}
    vec ($win, $fd, 1) = 1;
    $ss->{WBUF} .= $data;
    $ss->{WCB} = \&senddata_cb;
    $ss->{WARG} = $cb;
}

sub conalloc {
    my ($server, $method) = @_;
    my ($port, $fh, $addr, $sin, $f);

    $fh = new IO::Handle;
    if ($server =~ /^([^:]+):(\d+)/) {
        $server = $1;
        $port = $2;
    }
    unless ($addr = inet_aton ($server)) {
        $errors .= "$server: unknown host\n";
        return undef;
    }
    $sin = sockaddr_in ($port ? $port : $nntpport, $addr);
    socket ($fh, PF_INET, SOCK_STREAM, getprotobyname ('tcp'));
    select ((select($fh), $|=1)[0]);

#    # Stress test:
#    setsockopt ($fh, SOL_SOCKET, SO_SNDBUF, 8)
#       || &fatal (70, "SO_SNDBUF: $!\n");
#    setsockopt ($fh, SOL_SOCKET, SO_RCVBUF, 16)
#       || &fatal (70, "SO_RCVBUF: $!\n");

    bind ($fh, $bindsin) || &fatal (71, "$LOCALNAME: $!");

    $f = 0;
    ($f = fcntl $fh, F_GETFL, $f) || die "F_GETFL: $!";
    $f |= O_NONBLOCK;
    (fcntl $fh, F_SETFL, $f) || die "F_SETFL: $!";

    unless (connect ($fh, $sin) || $! == &EINPROGRESS) {
        $errors .= "$server: $!\n";
        return undef;
    }
    $sockets[fileno($fh)] = {
        SERVER => $server,
        METHOD => $method,
        FH => $fh,
        RBUF => '',
        WBUF => '',
        POS => 0,
        OFF => 0,
        RCB => undef,
        WCB => undef,
        RARG => undef,
        WARG => undef,
    };
    $nopen++;
    return fileno($fh);
}

my $msgid;

sub mungefrom ($) {
    $_ = $_[0];
    my ($name, $addr);

    if (/^From:\s+([^<>]*)<([^<>\s]+@[^<>\s]+)>$/i) {
        ($name, $addr) = ($1, $2);
    }
    elsif (/^From:\s+([^<>\s]+@[^<>\s]+)\s+\(([^\(\)]*)\)$/i) {
        ($name, $addr) = ($2, $1);
    }
    elsif (/^From:\s+([^<>\s]+@[^<>\s]+)$/i) {
        ($name, $addr) = ("", $1);
    }
    else {
        fatal (65, "Could not parse From address in:\n>$_");
    }

    $name =~ s/^\s*//;
    $name =~ s/\s*$//;
    while ($addr =~ s/^(.*\@.*)\./$1 <DOT> /g) {};
    $addr =~ s/\@/ <AT> /;
    $_[0] = <<"EOF";
From: $name <Use-Author-Address-Header\@[127.1]>
Author-Address: $addr
EOF
}

sub blockcheck {
    my ($val) = @_;
    $val =~ s/^\S+://;
    $val =~ s/\"//g;
    $val =~ tr/A-Z/a-z/;
    foreach (split /[\s<>,:]+/, $val) {
        if (/^[^@%]+%[^@]+@(.+)$/
            || /^[^@%]+@\[(.+)\]$/ && $1 !~ /^127\./) {
            $errors .= "Sorry, $_ is not a valid address.\n";
            last;
        }
        elsif (/^[^@]+(@.+)$/ && ($bdb{$1} || $bdb{$_})) {
            $errors .= "Address $_ has been blocked.\n";
            last;
        }
    }
}
sub read_article {
    my %hh;
    my @headers;
    my $lh;
    my $newsgroups;

    $headers = "";
    if ($QMAIL_CODES && $ENV{'UFLINE'}) {
        $headers .= $ENV{'UFLINE'};
        $hh{'From '} = $ENV{'UFLINE'};
    }
    while (<STDIN>) {
        next if (/^From / && $hh{'From '});
        last if /^\s*$/;
        $headers .= $_;
        next if $_ eq $WARNHDR;
        if (/^From / && !$hh{'From '}) {
            $hh{'From '} = $_;
            $lh = undef;
            next;
        }
        if (/^\s/) {
            $$lh .= $_ if ($lh);
            next;
        }
        &fatal (65, "malformed article header:\n $_")
            unless (/^(\S+):\s(.*)/);
        my ($hdrname, $hdrval) = ($1, $2);
        $hdrname =~ tr/A-Z/a-z/;
        if ($hdrname eq "received"
            || $hdrname eq "x-authentication-warning"
            || $hdrname eq "apparently-to"
            || $hdrname eq "to"
            || $hdrname eq "bcc"
            || $hdrname eq "status"
            || $hdrname eq "notice-requested-upon-delivery-to"
            || $hdrname eq "x-from"
            || $hdrname eq "mbox-line") {
            $lh = undef;
            next;
        }
        elsif (/^Cc: recipient list not shown:\s*;/i) {
            $lh = undef;
            next;
        }
        elsif ((!$Getopt::Std::opt_a && $hdrname eq "approved")
               || $hdrname eq "author-address"
               || $hdrname eq "nntp-posting-host"
               || /^(also-)?control:\s*(newgroup|rmgroup|ihave|sendme)\b/i) {
            $_ = "Old-$_";
            $hdrname = "Old-$hdrname";
        }
        elsif ($hdrname eq "x-loop" && /\b$MAILADDR\@$LOCALNAME\b/
               || $_ eq $LOOPHDR) {
            &fatal (0, "message in a loop... dropping\n");
        }
        elsif ($hdrname eq "path") {
            &fatal (0, "message in a loop... dropping\n")
                if ($hdrval =~ /(\!|\s|\A)$LOCALNAME(\!|\s|\Z)/);
            $hh{'Path'} = $hdrval unless ($hh{'Path'});
            $lh = undef;
            next;
        }
        elsif ($hdrname eq 'newsgroups') {
            if ($hh{'newsgroups'}) {
                $errors .= "Duplicate 'Newsgroups:' header.\n";
            }
            else {
                $newsgroups = $1 if $hdrval =~ /\s*(\S+)\s*/;
                $errors .= "Whitespace in 'Newsgroups:' header.\n"
                    if ($newsgroups =~ /\s/);
            }
        }
        elsif ($hh{$hdrname} && $hdrname eq 'from' && $FIRSTFROM) {
            $lh = undef;
            next;
        }
        if ($hh{$hdrname} &&
            ($hdrname eq "subject"
             || $hdrname eq "message-id"
             || (!$FIRSTFROM && $hdrname eq "from"))) {
            $lh = $hh{$hdrname};
        }
        else {
            $lh = $hh{$hdrname} = \$headers[++$#headers];
        }
        $$lh = $_;
    }
    if ($hh{'From '} && $hh{'From '} =~ /^From MAILER-DAEMON/i) {
        $errors .= "Can't post bounce messages.\n";
    }

    my $initialpath =
        ($LOCALADDR !~ /\d+(\.\d+){3}/ && $LOCALADDR ne $LOCALNAME) ?
            "$LOCALADDR!$LOCALNAME" : "$LOCALNAME";

    my $localpath = $MAILADDR;
    if ($newsgroups) {
        my $ngrps = 1 + scalar ($newsgroups =~ tr/,/,/);
        my $i;
        for ($i = 2; $i <= $ngrps; $i += 1) {
            $localpath = "${MAILADDR}-x$i!$localpath";
        }
    }

    unshift @headers, "Path: $initialpath!"
        . ($hh{'Path'} ? $hh{'Path'} : $localpath) . "\n";

#    unless ($hh{'message-id'}) {
#       $hh{'message-id'} = \$headers[++$#headers];
#       $headers[$#headers] = "Message-ID: " . &mkmsgid . "\n";
#    }
#    ${$hh{'message-id'}} =~ s/\@$LOCALADDR\>/\@$LOCALNAME\>/;
    push @headers, "Date: " . &rfc822date . "\n" unless ($hh{'date'});
    unless ($hh{'subject'}) {
        $hh{'subject'} = \$headers[++$#headers];
        $headers[$#headers] = "Subject: none\n";
    }
    ($lh = $hh{'mail-to-news-contact'})
        || ($lh = \$headers[++$#headers]);
    $$lh = "Mail-To-News-Contact: $COMPLAINTS\n";
    unless ($hh{'organization'}
            && $ {$hh{'organization'}} =~ /^\S+:\s*\S/) {
        $lh = \$headers[++$#headers] unless $lh = $hh{'organization'};
        $$lh = "Organization: $ORGANIZATION\n";
    }

    $errors .= "Missing/invalid message-ID.\n"
        unless ($hh{'message-id'}
                && $ {$hh{'message-id'}} =~ /^\S+:\s+(<.+>)$/
                && ($msgid = $1));

    my $cancelid;
    if ($hh{'control'}) {
        if ($hh{'supersedes'}) {
            $errors .= "Can't have both Control: and Supersedes: headers.\n";
        }
        elsif ($ {$hh{'control'}} =~ /^\S+:\s+cancel(.*)$/) {
            if ($1 =~ /^\s+(<.+>)$/) {
                $cancelid = $1;
            }
            else {
                $errors .= "Malformed control:\n " . $ {$hh{'control'}};
            }
        }
    }
    elsif ($hh{'supersedes'}) {
        if ($ {$hh{'supersedes'}} =~ /^\S+:\s+(<.*>)$/) {
            $cancelid = $1;
        }
        else {
            $errors .= "Malformed supersedes:\n " . $ {$hh{'supersedes'}};
        }
    }

    $headers = "From anmetet\@$LOCALNAME " . scalar (localtime) . "\n"
        . $headers unless ($headers =~ /^From /);
    $errors .= "Missing 'From:' header.\n" unless ($hh{'from'});
    #&blockcheck ($hh{'From '}) if $hh{'From '};
    &blockcheck ($ {$hh{'from'}}) if $hh{'from'};
    &blockcheck ($ {$hh{'sender'}}) if $hh{'sender'};
    &blockcheck ($ {$hh{'reply-to'}}) if $hh{'reply-to'};
    &blockcheck ($ {$hh{'followup-to'}}) if $hh{'followup-to'};

    if ($Getopt::Std::opt_p) {
        if (!$newsgroups) {
            $hh{'newsgroups'} = $lh = \$headers[++$#headers];
        }
        else {
            $lh = $hh{'newsgroups'};
        }
        $newsgroups = $Getopt::Std::opt_p;
        $$lh = "Newsgroups: $Getopt::Std::opt_p\n";
    }

    undef $Getopt::Std::opt_m unless $hh{'newsgroups'};

    $loginfo = "";
    $loginfo .= " " . $hh{'From '} if $hh{'From '};
    $loginfo .= " " . ($Getopt::Std::opt_m ? 'Unmangled-' : '')
        . $ {$hh{'from'}} if $hh{'from'};
    $loginfo .= " " . $ {$hh{'message-id'}} if $hh{'message-id'};
    $loginfo .= " " . $ {$hh{'subject'}} if $hh{'subject'};
    $loginfo .= " " . $ {$hh{'newsgroups'}} if $hh{'newsgroups'};
    $loginfo .= " " . $ {$hh{'followup-to'}} if $hh{'followup-to'};
    $loginfo .= " " . $ {$hh{'control'}} if $hh{'control'};
    $loginfo .= " " . $ {$hh{'approved'}} if $hh{'approved'};
    $loginfo .= " " . $ {$hh{'supersedes'}} if $hh{'supersedes'};

    mungefrom ($ {$hh{'from'}}) if ($Getopt::Std::opt_m);

    my $modaddr;
    if ($newsgroups) {
        $crosspostidx = 1 + ($newsgroups =~ tr/,/,/);
        unless ($hh{'approved'}) {
            my @grouplist = split /,/, $newsgroups;
		 #MTS: the line below used to be commented out
		 #and the value was 12 instead of 5
                 $errors .= "Too many newsgroups.\n" if (@grouplist > 5);
		 #MTS: the line above used to be commented out
            foreach (@grouplist) {
                if (defined ($gdb{$_}) && $gdb{$_} eq 'm') {
                    $errors .= "Unknown moderator for group '$_'.\n"
                        unless $modaddr = &moderator ($_);
                    $modaddr && unshift @headers, "To: $modaddr\n";
                    last;
                }
            }
        }
    }
    else {
        my $subj;
        $subj = $ {$hh{'subject'}} if $hh{'subject'};
        if ($subj) {
            local (*MAIL);
            $subj =~ s/\S+:\s*//;
            if ($subj =~ /^(help|info)\b/i && replypipe (\*MAIL, @headers)) {
                #&writelog ("\nHELP:\n", $loginfo);
                select (MAIL);
                print "Subject: Instructions for using "
                    . "$MAILADDR\@$LOCALNAME\n";
                catfile $HELPMSG;
                &leave (0);
            }
            #elsif ($subj =~ /^(list(\s+(.*))|group(\s+(.*))|groups(\s+(.*)))/i
            elsif ($subj =~ /^list(\s+(.*))/i
                   && replypipe (\*MAIL, @headers)) {
                my $re = $2;
                #&writelog ("\nLIST:\n", $loginfo);
                select (MAIL);
                if ($re) {
                    print "Subject: $MAILADDR\@$LOCALNAME: "
                        . "groups matching '$re'\n";
                }
                else {
                    print "Subject: Groups available through "
                        . "$MAILADDR\@$LOCALNAME\n";
                }
                print "\n";
                &dolist ($re);
                &leave (0);
            }
        }
        $errors .= "Missing/invalid 'Newsgroups:' header.\n";
    }

    untie %gdb;  # Save some memory?

    if ($Getopt::Std::opt_x && defined ($crosspostidx) && $crosspostidx > 1) {
        chomp (${$hh{'subject'}});
        ${$hh{'subject'}} .= " [x" . $crosspostidx . "]\n";
    }

    unless ($errors) {
        my %idb;
        my $dayno = int(time / (24*60*60));

        tie_lock (%idb, $MSGIDDB);

        if ($cancelid && !$idb{$cancelid} && !$Getopt::Std::opt_a) {
            $errors .= "Can't cancel article $cancelid.\n";
        }
        else {
            $firsttime = !(defined $idb{$msgid});
            $idb{$msgid} = $dayno;
        }

        if (!$idb{'.clean'}) {
            $idb{'.clean'} = $dayno;
        }
        elsif ($idb{'.clean'} != $dayno) {
            foreach (keys %idb) {
                delete $idb{$_} if $idb{$_} < $dayno - $CANCELDAYS;
            }
            $idb{'.clean'} = $dayno;
        }

        untie_unlock (%idb);
    }

    print ARTICLE @headers, "\n";
    my ($endnl, $lines, $qlines) = (1, 0, 0);
    while (<STDIN>) {
        $_ = ".$_" if /^\.\r?$/;
        #$_ = ">$_" if /^From /;
        $lines++;
        $qlines++ if /^>/;
        $qlines-- if /^</;
        print ARTICLE;
        $endnl = scalar (/\n/);
    }
    print ARTICLE "\n" unless $endnl;
    my $xlines = 2 * $qlines - $lines;
    # Please news servers that reject too many quoted lines.
    print ARTICLE "\n" x $xlines if ($xlines > 0);
    print ARTICLE ".\n";

    select ((select(ARTICLE), $|=1)[0]);

    my $exitcode = $errors ? 65 : 0;

    if (!$errors && $Getopt::Std::opt_F) {
        seek (ARTICLE, 0, 0);
        my $cmd = $Getopt::Std::opt_F . ' ' . $crosspostidx;
        ($errors, $exitcode) = runfilter ($cmd);
        $errors = '' unless $exitcode;
    }

    if ($errors) {
        if ($exitcode == 71 || $exitcode == 74 || $exitcode == 75
            || $exitcode == 111) {
            &writelog ("\nDEFERRED:\n", $loginfo, $errors)
                if $firsttime;
        }
        else {
            &writelog ("\nBOUNCED:\n", $loginfo, $errors);
            &savearticle ($LOGBAD);
        }
        &fatal ($exitcode, $errors);
    }

    if ($modaddr) {
        push @headers, $WARNHDR, $LOOPHDR;
        seek (ARTICLE, 0, 0);
        open STDIN, "<&ARTICLE" || die "could not dup article";
        system $SENDMAIL, "-odq", "-f", $MODBOUNCE, $modaddr;
        &writelog ("\nFORWARDED:\n", $loginfo, $errors);
        &savearticle ($LOGGOOD);
        &leave (0);
    }

    return 1;
}

sub postgetresult {
    my ($fd, $line) = @_;
    my $method = $sockets[$fd]->{METHOD};
    unless ($line =~ /^(\d+)\b/) {
        confree ($fd, "%s", $line);
        return;
    }
    my $code = $1;
    if ($method eq 'ihave' && $code == "235"
        || $method eq 'post' && ($code == "240"
                                 || $line =~ /^441.*\bduplicate\b/i)) {
        $nok++;
        confree ($fd, "%s", $line);
    }
    elsif ($method eq 'ihave' && $code == "436"
           || $method eq 'post' && $line =~ /^441 400/) {
        $nagain++;
        confree ($fd, "%s", $line);
    }
    else {
        $nrej++;
        confree ($fd, "%s", $line);
    }
}

sub postsendarticle {
    my ($fd, $line) = @_;
    my $ss = $sockets[$fd];
    my $data = "";

    seek (ARTICLE, $ss->{OFF}, 0);
    if (read (ARTICLE, $data, 4096)) {
        $ss->{OFF} = tell (ARTICLE);
        $data =~ s/\n/\r\n/g;
        senddata ($fd, $data, \&postsendarticle);
    }
    else {
        recvline ($fd, \&postgetresult);
    }
}

sub listgetgroup {
    my ($fd, $line) = @_;
    if ($line =~ /^.\r?$/) {
        confree ($fd);
        $nok++;
        return;
    }
    $line =~ s/\r?\n//;
    my ($group, $stat) = (split ' ', $line, 4)[0,3];
    unless ($stat && $stat =~ /^[ynxmj]|=.*$/) {
        &confree ($fd, "bad group:  %s\n", $line);
        return;
    }
    if ($group !~ /^mail\./) {
        if ($stat eq 'm') {
            $gdb{$group} = 'm';
        }
        elsif ($stat eq 'y') {
            $gdb{$group} = 0 if (!defined $gdb{$group});
            $gdb{$group}++ unless ($gdb{$group} eq 'm');
        }
        elsif ($stat =~ /^=/) {
            $gdb{$group} = $stat;
        }
    }
 leave:
    recvline ($fd, \&listgetgroup);
}

sub cmdsent {
    my ($fd, $line) = @_;
    my $method = $sockets[$fd]->{METHOD};
    unless ($line =~ /^(\d+)\b/) {
        confree ($fd, "%s", $line);
        return;
    }
    my $code = $1;
    if ($method eq 'list') {
        if ($code ne "215") {
            $nrej++;
            confree ($fd, "%s", "$line");
        }
        else {
            recvline ($fd, \&listgetgroup);
        }
        return;
    }
    if ($method eq 'post' && $code ne "340"
        || $method eq 'ihave' && $code ne "335") {
        # If this is a duplicate, assume the article made it out there
        if ($method eq 'ihave' && $code == "435"
            && $line =~ /\bDuplicate\b/i) {
            $nok++;
        }
        elsif ($method eq 'ihave' && $code eq "436"
               || $method eq 'post' && $line =~ /^441 400/) {
            $nagain++;
        }
        else {
            $nrej++;
        }
        confree ($fd, "%s", "$line");
        return;
    }
    postsendarticle ($fd);
}

sub connected {
    my ($fd, $line) = @_;
    my $method = $sockets[$fd]->{METHOD};
    unless ($line =~ /^200\b/) {
        $nagain++;
        confree ($fd, "%s", $line);
        return;
    }
    if ($method eq 'list') {
        senddata ($fd, "list\r\n");
    }
    elsif ($method eq 'ihave') {
        senddata ($fd, "ihave $msgid\r\n");
    }
    elsif ($method eq 'post') {
        senddata ($fd, "post\r\n");
    }
    else {
        &fatal (70, "unknown posting method \"$method\" for "
                . $sockets[$fd]->{SERVER} . "\n");
    }
    recvline ($fd, \&cmdsent);
}

sub modereader {
    my ($fd, $line) = @_;
    my $method = $sockets[$fd]->{METHOD};
    unless ($line =~ /^200\b/) {
        $nagain++;
        confree ($fd, "%s", $line);
        return;
    }
    if ($method eq 'post' && $line =~ /INN/ && $line !~ /NNRP/) {
        senddata ($fd, "mode reader\r\n");
        recvline ($fd, \&connected);
        return;
    }
    &connected (@_);
}

sub postinit {
    tmpfile (*ARTICLE);
    &read_article;
    while (@SERVERS) {
        my $fd = conalloc (splice (@SERVERS, 0, 2));
        next unless (defined $fd);
        recvline ($fd, \&modereader);
    }
}

sub groupinit {
    while (@SERVERS) {
        my $fd = conalloc ($SERVERS[0], 'list');
        splice (@SERVERS, 0, 2);
        next unless (defined $fd);
        recvline ($fd, \&connected);
    }
}

sub timeouterr {
    my ($i, $ss);
    for ($i = 0; $i < @sockets; $i++) {
        $errors .= sprintf ("%24s:  connection timed out\n", $ss->{SERVER})
            if $ss = $sockets[$i];
    }
}

sub selloop {
    while ($nopen) {
        my ($i, $rout, $wout, $nfound);
        #$nfound = select ($rout=$rin, $wout=$win, undef, 45);
        $nfound = select ($rout=$rin, $wout=$win, undef, 720); #MTS changed TIMEOUT
        unless ($nfound) {
            &timeouterr;
            last;
        }
        for ($i = 0; $nfound > 0 && $i <= $#sockets; $i++) {
            if (vec ($rout, $i, 1)) {
                &{$sockets[$i]->{RCB}} ($i);
                $nfound--;
            }
            if (vec ($wout, $i, 1)) {
                &{$sockets[$i]->{WCB}} ($i);
                $nfound--;
            }
        }
        &fatal (70, "select: left over descriptors\n") if ($nfound);
    }
}

sub dopost {
    my $dolog;

    &postinit;
    &selloop;

    print $errors;

    if (!$nok && $nagain && ($nrej << 1) < $nservers) {
        &writelog ("\nDEFERRED:\n", $loginfo, $errors);
        if ($Getopt::Std::opt_F) {
            my $cmd = $Getopt::Std::opt_F . ' -' . $crosspostidx;
            runfilter ($cmd);
        }
        &leave (75);
    }
    elsif ($nok) {
        &writelog ("\nPOSTED:\n", $loginfo, $errors);
        &savearticle ($LOGGOOD);
        &leave (0);
    }
    else {
        &writelog ("\nREJECTED:\n", $loginfo, $errors);
        &savearticle ($LOGBAD);
        if ($Getopt::Std::opt_F) {
            my $cmd = $Getopt::Std::opt_F . ' -' . $crosspostidx;
            runfilter ($cmd);
        }
        &fatal (65, '');
    }
}

sub doblock {
    my $file;
    my %ndb;
    foreach $file ($BLOCK) {
        my $NDB = "$file~$$~";
        open (SRC, "<$file") || &fatal (1, "$file: $!\n");
        unlink $NDB;
        push @tmpfiles, $NDB;
        tie (%ndb, "DB_File", $NDB, O_RDWR|O_CREAT|O_EXCL, 0664, $DB_HASH)
            || &fatal (1, "$NDB: $!\n");
        while (<SRC>) {
            chomp;
            s/\#.*//;
            next if /^\s*$/;
            tr/A-Z/a-z/;
            $ndb{$_} = 1;
        }
        untie %ndb;
        rename ($NDB, "$file.db") || &fatal (1, "rename: $!\n");
    }
}

sub dogroups {
    my $NGDB = "$GROUPDB~$$~";
    unlink $NGDB;
    push @tmpfiles, $NGDB;
    my $oldumask = umask (0);
    tie (%gdb, "DB_File", $NGDB, O_RDWR|O_CREAT|O_EXCL, 0664, $DB_BTREE)
        || &fatal (1, "$NGDB: $!\n");
    umask ($oldumask);
    &groupinit;
    &selloop;
    untie %gdb;
    print STDERR $errors;
    if ($nok > 0 && $nok > int ($nservers/2)) {
        rename ($NGDB, $GROUPDB) || &fatal (1, "rename: $!\n");
    }
    else {
        print STDERR "Too many unavailable servers.  Aborted\n";
        &leave (1);
    }
}

sub dolist {
    my ($regexp) = @_;
    $regexp = '' unless defined ($regexp);
    # If we have many servers, skip groups with only a few
    # servers... probably just local stuff
    my $threshold = int (($nservers + 1)/2);
    foreach (keys %gdb) {
        next unless /^$regexp/o;
        if ($gdb{$_} eq 'm') {
            print "$_ (moderated)\n" if &moderator ($_);
        }
        elsif ($gdb{$_} =~ /^=/) {
        }
        elsif ($gdb{$_} >= $threshold) {
            print "$_\n";
        }
    }
}

umask (0007);

($myaddr = inet_aton ($LOCALADDR)) || die "$LOCALNAME: unknown host";
$bindsin = sockaddr_in (0, $myaddr);
($nntpport = getservbyname ('nntp', 'tcp'))
    || die "could not get nntp port number";
$errors = "";

sub usage {
    my $prog = $0;
    $prog =~ s/^.*\///;
    print STDERR <<"EOF";
usage:
 $prog [-[adfm]] [-Ffil] [-oOrg]          post article
 $prog [-[adfm]] [-Ffil] [-oOrg] -p Grps  post article to specific groups
 $prog -b                                 build source block database
 $prog [-d] -g                            build newsgroups database
 $prog -l [regexp]                        list news groups
 $prog -c Addr ...                        Check if Addr is blocked
options:
        -a   Allow approved headers (for moderators to send approved: messages)
        -d   Enable debugging (print NNTP traffic)
        -f   Take pasted from headers from remailers (second From: header honored)
        -m   Mangle From header to thward spam
        -F   Check exit status of filter 'fil' before posting
        -o   Set default organization header to 'Org'
        -p   Post to '+' separated list of groups
EOF
    exit 1;
}
if (@ARGV && $ARGV[0] eq '-l') {
    if (@ARGV == 1) {
        $lre = "";
    }
    elsif (@ARGV == 2) {
        $lre = $ARGV[1];
    }
    else {
        &usage;
    }
}
elsif (@ARGV && $ARGV[0] eq '-c') {
    my $addr;
    shift;
    tie (%bdb, "DB_File", "$BLOCK.db", O_RDONLY, 0, $DB_HASH);
    $errors = '';
    foreach $addr (@ARGV) {
        &blockcheck ($addr);
    }
    print $errors;
    &leave ($errors ne '');
}
else {
    getopts ('o:dbgp:mfaF:x') || &usage;
    &usage if (@ARGV
               || ($Getopt::Std::opt_b
                   && ($Getopt::Std::opt_g || $Getopt::Std::opt_d))
               || (($Getopt::Std::opt_m || $Getopt::Std::opt_f
                    || $Getopt::Std::opt_a || $Getopt::Std::opt_o
                    || $Getopt::Std::opt_p)
                   && ($Getopt::Std::opt_b || $Getopt::Std::opt_g)));
    $ORGANIZATION = $Getopt::Std::opt_o if ($Getopt::Std::opt_o);
    $FIRSTFROM = !$Getopt::Std::opt_f;
    if ($Getopt::Std::opt_p) {
        $Getopt::Std::opt_p =~ s/\++/,/g;
        $Getopt::Std::opt_p =~ s/^,*(.*?),*$/$1/;
    }
    if ($Getopt::Std::opt_x) {}
}

unless ($Getopt::Std::opt_g || $Getopt::Std::opt_b) {
    my $b = new DB_File::BTREEINFO;
    $b->{'cachesize'} = 65536 unless defined ($lre);  # Doesn't work?
    tie (%gdb, "DB_File", $GROUPDB, O_RDONLY, 0, $b)
        || &fatal (75, "$GROUPDB: $!\n");
    tie (%bdb, "DB_File", "$BLOCK.db", O_RDONLY, 0, $DB_HASH);
}

if ($Getopt::Std::opt_g) {
    &dogroups;
}
elsif ($Getopt::Std::opt_b) {
    &doblock;
}
elsif (defined ($lre)) {
    &dolist ($lre);
}
else {
    $receiving_mail = 1;
    check_concurrency $CLDIR if defined $CLDIR;
    &dopost;
}

&leave (0);