#!/usr/bin/perl
#
# mailman-block-non-members.pl -- insert in front of a MailMan list-submission
# address to block non-members of that list from posting.  If a non-member
# posts, it will respond and request confirmation that they are human before
# allowing it through.

# ---------------------------------------------------------------------------

$MAGIC_TOKEN = 'nonmemberok';

$ALLOW_ANYONE_AT_SUBBED_DOMAINS = 1;

# ---------------------------------------------------------------------------

$VERSION = 'May 11 2001 jm';
$DEBUG = 0;

if ($ARGV[0] eq '-d') { shift; $DEBUG = 1; }
$LIST = $ARGV[0];
$DOM = $ARGV[1];

if (!defined $DOM) {
  die ("usage: block_non_members.pl listname listdomain\n");
}

my $cmd = 'sudo /home/mailman/bin/list_members '.$LIST;
$POSTCMD = '/home/mailman/mail/wrapper post '.$LIST;

my @msg_so_far = ();
my $addr = '';

while (<STDIN>) {
  /^From \S+\@\S+ / and next;

  push (@msg_so_far, $_);
  /$MAGIC_TOKEN/i and allow();
  /^$/ and last;

  if (/^From: \s*(.*)\s*$/i) {
    $_ = $1;

    if (/<(.*?)>/) { $addr = $1; }
    elsif (/^(.*?) \(/) { $addr = $1; }
    else { $addr = $_; }
  }
}

if ($DEBUG) {
  warn "raw From addr: \"$addr\"\n";
}

$addr =~ s/\n.*$//gs;
$addr =~ s/\"//gs;
$addr =~ s/\s//gs;

if (!defined $addr || $addr eq '') {
  mydie ("From: address not parseable or not present:\n".(join ('',@msg_so_far)));
}

my $pattern = qr{^${addr}$}i;
if ($ALLOW_ANYONE_AT_SUBBED_DOMAINS) {
  my $addrdom = $addr; $addrdom =~ s/^.*\@/\@/gs;
  $pattern = qr{${addrdom}$}i;
}

if ($DEBUG) {
  warn "From addr: \"$addr\" pattern: /$pattern/\n";
}

open (MEMBS, "$cmd 2>&1 |") or mydie ("cannot run '$cmd'");
while (<MEMBS>) {
  if ($DEBUG) { warn "Subscriber: $_"; }
  /${pattern}/ and allow();
}
close MEMBS;

while (<STDIN>) {
  push (@msg_so_far, $_);
  /$MAGIC_TOKEN/i and allow();
}

reject();
mydie ("shouldn't get this far");

# ---------------------------------------------------------------------------



sub allow {
  if ($DEBUG) { warn "allow this message\n"; exit 0; }

  open (OUT, "| ".$POSTCMD)
  		or mydie ("failed to deliver to $POSTCMD");
  print OUT @msg_so_far;
  while (<STDIN>) { print OUT; }
  close OUT or mydie ("failed to deliver to $POSTCMD");
  exit 0;
}

sub reject {
  if ($DEBUG) { warn "reject this message\n"; exit 0; }

  open (MAIL, "| /usr/lib/sendmail -v -oi -t");
  print MAIL qq{X-generated-by: block_non_members.pl $VERSION
From: $LIST-owner\@$DOM
To: $addr
Subject: require confirmation for non-member posting to $LIST\@$DOM

(**DO NOT REPLY** to this message -- it is automatically generated.)

You are not a member of the $LIST list.  Due to high levels of unsolicited
commercial email to the list address, we now require confirmation from the
poster before a non-member post is accepted.

Re-send your mail (reproduced below), with the magic word "$MAGIC_TOKEN"
included *anywhere* in the mail text, and it will be permitted through.

(Note that we do not have any policy against non-member postings -- this
is just an anti-spam measure.)


-------------- Original message follows:

};
  print MAIL @msg_so_far;
  while (<STDIN>) { print MAIL; }
  close MAIL;
  exit 0;
}

# ---------------------------------------------------------------------------

sub mydie {
  mywarn (@_);
  exit 75;
}

sub mywarn {
  my $str = join ('', @_);
  warn $str;
  if ($DEBUG) { warn "not sending mail to $LIST-owner\n"; return; }

  open (MAIL, "| /usr/lib/sendmail -v $LIST-owner\@$DOM");
  print MAIL qq{X-generated-by: block_non_members.pl $VERSION
From: Postmaster\@$DOM
To: $LIST-owner\@$DOM
Subject: ERRORS from block_non_members script

The following error occurred:

  $str

-------------- Original message follows:

};
  print MAIL @msg_so_far;
  while (<STDIN>) { print MAIL; }
  close MAIL;
}

# ---------------------------------------------------------------------------