#!/usr/bin/perl -wT

##############################################################################
# dbmailer.pl                   Version 0.91
# Created 09/28/01              Last Modified 10/15/01
##############################################################################
# COPYRIGHT NOTICE
# Copyright (C) 2001 Bryce Allen (ballen@mum.edu)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
##############################################################################
# DESCRIPTION
#
# A mailing list script which queries a database to find destination emails.
#
# usage: put this in /etc/aliases
#
# 	list-name: "|/path/to/thisscript.pl list-name"
#
#
# depending on your email server, you may need to run an
# alias update script.
# Postfix users: run 'postalias /etc/aliases'
#
##############################################################################
# Required modules and pragmas

use strict;
use Mail::Internet;
use Mail::Field;
use Sys::Syslog qw(:DEFAULT setlogsock);
use DBI;

# End
##############################################################################
# Options

# first argument should be the first part of the list email
# e.g. walrus-general@antarctica.org should be walrus-general
my $list_name = shift;

# db options
my $dbdriver = 'mysql';
my $dbhost = 'localhost';
my $dbname = 'mailinglist';
my $dbuser = 'dbmailer';
my $dbpass = 'secret';
my $dbtable = 'users';

# The fields in the database containing emails.
# The message is sent to the first field only -
# the rest are used to verify the sender.
# Users typically have mutliple email accounts - 
# this allows them to send messages to the list
# from any of their addresses, even if the list
# is private.
my @db_email_fields = qw(email email2);

# Reply To field will be set to the list email.
# I discourage anyone from using this without
# fully evaluating the drawbacks.
# See http://www.unicom.com/FAQ/reply-to-harmful.html
my $reply_to_list = 0;

# used in the footer
my $hostname = 'mumstudents.org';
my $list_url = 'http://linux.mum.edu/~class2000';
my $list_email = "$list_name\@$hostname";

my $subject_prefix = "[$list_name] ";

# appended to all messages
my $footer = <<FOOTER;


___________________________________________
$list_name mailing list
$list_email
$list_url
FOOTER

# security options
my $verify_caller = 0; # turn off for debugging
my $private_list = 1; # turn off for debugging

# should be configured by your MTA
# Postfix users: see 'default_privs' in main.cf
my $required_uid = -1;
my $required_gid = -1;

my $required_puid = -1; # not used yet...
my $required_pgid = -1;

my $logsock = 'unix'; # unix or inet

# End
##############################################################################
# INITIALIZATION

# Untaint the environment
$ENV{PATH} = '/bin';
$ENV{BASH_ENV} = '';

# setup logging via syslog
setlogsock($logsock);
openlog($0, 'pid,cons', 'mail');

# End
##############################################################################
# CALLER VERIFICATION

# verify that the uid/gid are what we expect, and that euid/egid are the same
my $fatal_err = 0;
if(!(($required_uid == $<) && ($< == $>))) {
	syslog('warning', "Illegal uid: $< ($>)\n");
	$fatal_err = 1;
}
if( !( ($required_gid == $() && ($( == $)) ) ) {
	syslog('warning', "Illegal gid: $( ($))\n");
	$fatal_err = 1;
}

# if the above uid/gid tests failed, log the output of ps for the parent pid
# may let us track down who was trying to do mischief
if($fatal_err && $verify_caller) {
	my $parent = getppid();
	syslog('warning', `/bin/ps whlep $parent` . "\n"); # wide, no headers, long, env, choose by pid
	die "$0: fatal errors, could not send message.";
}

# End
##############################################################################
# MAIN SCRIPT CODE

# read in the message from STDIN (from the MTA)
my $mail_object = new Mail::Internet(*STDIN);

# extract the headers etc
my $header = $mail_object->head();
my $body_ref = $mail_object->body();
my ($from_email) = Mail::Field->extract('From', $header)->addresses();

my @to_addresses = Mail::Field->extract('To', $header)->addresses();
foreach (@to_addresses) { $_ = lc $_; }
my %to_hash;
@to_hash{@to_addresses} = ();

# basic mail loop prevension
my @delivered_to = $header->get('Delivered-To');
foreach (@delivered_to) {
	if($_ eq $list_email) {
		syslog('warning', "$0: Potential mail loop detected, not sending message to $list_email");
		exit;
	}
}

# connect to the database
my $dbh = DBI->connect("DBI:$dbdriver:$dbname:$dbhost", $dbuser, $dbpass, { AutoCommit => 1 })
	or die "$0: error connecting to database: $DBI::errstr";

# SELECT email fields
my $sql = 'SELECT ' . join(', ', @db_email_fields) . " FROM $dbtable";
my $query = $dbh->prepare($sql);
$query->execute() or die "$0: error selecting from db: $DBI::errstr";

# build recipient list and check to see if sender ($from_email) is a list member
my ($from_list_member, $address_in_to) = (0, 0);
my (@recipients, @row);
while(@row = $query->fetchrow_array()) {
	foreach (@row) {
		if(exists $to_hash{lc($_)}) {
			$address_in_to = 1;
			last if $from_list_member;
		}
		if(!$from_list_member && $from_email eq lc($_)) {
			$from_list_member = 1;
			last if $address_in_to;
		}
	}

	# don't send duplicates created from 'Rely All'ing
	if(!$address_in_to && defined($row[0])) {
		push @recipients, $row[0];
	}
}

# clean up db
$query->finish();
$dbh->disconnect() or die "$0: error closing database: $DBI::errstr";

# was the sender in the database?
if(!$from_list_member && $private_list) {
	syslog('warning', "invalid sender ($from_email)");
	die "$0: fatal errors, could not send message.";
}

# everything checks out ok, prepare headers
my @footer_lines = split "/(?=\n)/", $footer;
push (@$body_ref, @footer_lines); # body is array of lines, see perldoc Mail::Internet

my $subject = $header->get('Subject');
if(index($subject, $subject_prefix) == -1) {
	$header->replace('Subject', $subject_prefix . $subject);
}

if($reply_to_list) {
	$header->replace('Reply-To', $list_email);
}

$header->add('Delivered-To', $list_email);

# Send the email (finally)
# It would be faster to send them all at once, but
# hotmail filters out email that doesn't have
# your address in the To: field, or if there
# are too many other addresses in To:, so we want
# to tailor make the To: field for each recipient
my $email;
foreach $email (@recipients) {
	if(exists $to_hash{lc($email)}) {
		next;
	}
	$header->replace('To', "$list_email, $email");
	$mail_object->smtpsend( Host => 'localhost',
							To => $email );
}

# close syslog
closelog();

# End script
##############################################################################