#!/usr/bin/perl

# courier-to-mailman.pl by Ben Kennedy <ben@zygoat.ca>.
#
# Original version 30 July 2003, which was called as a || delivery instruction
# and returned a list of new delivery instructions for courier to process.
#
# Modified 22 July 2004, to be called as a normal pipe | delivery instruction,
# which will directly inject to mailman or return a message/error code as appropriate.
#
# Modified 16 Sep 2004, to eliminate any "+kkjlsdjklfklj" (plus sign followed by anything)
# that might be appended to the local delivery address.  Often, bounce probes will come back
# to e.g. doggiebox-bounces+66d7614e97d48965cce11b08e11a6e579d58b6e9@lists.zygoat.ca
# where the appended id tells mailman whom to unsubscribe.  Previously, the script choked
# on this, instead trying to find a mailing list of the entire name.
#
# # # # # # # # # # #
#
# This is a simple script designed to facilitate dynamic aliasing for
# a dedicated mailing list domain serving any number of Mailman lists.
#
# Usage: configure as a piped delivery instruction for the list server domain, e.g.:
#	@lists.zygoat.ca: |/path/to/courier-to-mailman.pl
#
# And that OUGHT to be it!
#

# Path to local mailman installation:
$MAILMAN = '/usr/local/mailman';
# Path to mailman var data dirs:
$MAILMANVAR = '/usr/local/mailman';
# E-mail of postmaster in case of dire failures:
$POSTMASTER = 'postmaster@zygoat.ca';

# Extract the appropriate mail delivery address from the environment.
# Depending how aliases are configured and expanded locally, we must select
# the proper environment variable to get the string which corresponds to the
# original request address of the incoming message (doggiebox-subscribe).
#
# Usually this will be LOCAL which corresponds to the local part of the
# recipient address, but might also be EXT or EXT2 depending on how the mail user/alias
# for the list server catch-all is configured.  Uncomment the printenv line below
# and examine its contents after sending a test message, if in doubt.
#
$deliver = $ENV{'LOCAL'};

#`printenv >/tmp/mailman-env`;
#`id >>/tmp/mailman-env`;

# Here are the known/expected verbs (reserved words in end of list names):
$VERBS = ',post,admin,bounces,confirm,join,leave,owner,request,subscribe,unsubscribe,';

# Ensure we snagged something suitable from the environment
if ($deliver eq '')
	{
	print <<EOT;
# $0 - error
# No suitable delivery was found in the environment.
# This is probably due to a configuration error.  See source for details.
EOT
	exit 64;
	}

# split the extension into two parts (e.g. for food-sack-bar):
# $deliver =~ m/(.*?)-*(\w+)$/; -- amended, below:
$deliver =~ m/(.*?)-*(\w+)(\+.+)*$/;	# also remove any trailing "+sdjklfklsdfjkl" that might be appended to some bounce probes.
$a = $1 || 'unknown';	# will contain the first n-1 sections (food-sack)
$b = $2 || 'request';	# will contain the last section (bar)
if ($a eq '')
	{
	# there was only one component to begin with, therefore must be list name
	$listname = $a;
	$verb = 'post';
	}
elsif ($VERBS =~ m/,$b,/)
	{
	# second component was a verb, so first part is the list name
	$listname = $a;
	$verb = $b;
	}
else {
	# the whole shebang must be just the list name
	$listname = $deliver;
	$verb = 'post';
	}

# Try to determine whether the requested list actually exists.
# If it doesn't, generate a non-zero code since otherwise the message
# will just get stuck in queue and user will never hear back.
if (! -d "$MAILMANVAR/lists/$listname")
	{
	print "There is no list by the name of \"$listname\".\n";
	exit 64;	# Indicates failure to courier
	}

else {
	# Open a pipe to mailman with the appropriate arguments.
	if (!(open (MAILMAN, "|$MAILMAN/mail/mailman $verb $listname")))
		{
		print "An internal error occurred (can't find mailman); please notify $POSTMASTER.\n";
		exit 64;	# Indicate failure
		}
	# Feed our stdin to mailman.	
	while (<STDIN>)
		{ print MAILMAN; }
	close MAILMAN;
	
	# And exit success (should probably get return code from the pipe process...)
	exit 0;
	}

# The end.