#!/usr/bin/perl
#
# Copyright (c) 2005, Adam Bernstein, All Rights Reserved.
# See http://mpgedit.org/approver/index.html#copyright for licensing terms.
#
# Configure these paths for your local install of Majordomo.
#
$MAJORDOMO_DIR   = "/usr/majordomo";
$APPROVED_DB_DIR = "$MAJORDOMO_DIR/lists";
$BOUNCED_LOG_DIR = "$MAJORDOMO_DIR";
$DEBUG           = 0;
$SMDEBUG         = 0;
#
# When SMDEBUG is TRUE, two things happen: 1) the original input e-mail is
# saved to /tmp/sendmail.txt.  2) the temporary processed output mail file
# /tmp/approved_nnnn (where nnnn is the PID) is not deleted.
#
# Remember to create mailinglist.cf files in the above directory
# for each mailing list containing the following configuration:
#$APPROVED_STRING = "approved: password\n\n";
#
#
# Description:
#
# Script to auto approve a Majordomo moderated mailing list posting based on
# the incoming e-mail address.  This is slightly dangerous, as a spoofed
# To: e-mail address for an approved account can then post to the mailing
# list.  This is a risk that will be taken for the convenience factor
# afforded by this operation.
#
# This script also inserts a blank line after the "approved: password"
# line in an e-mail. This insures a Majordomo moderated list will not drop 
# the subject line if you forget to add this required blank line.
#
# This script is part of a larger command pipeline invoked from rmmime.
# rmmime calls demime (http://scifi.squawk.com/demime.html) ahead of 
# approved, a script that removes MIME attachments from mail.  The headers
# inserted by demime is what allows approved to reliably locate the beginning
# of the e-mail body, and insert the approved: line for free.
#
require "ctime.pl";

$from         = 0;
$to           = 0;
$subj         = 0;
$approved     = 0;
$approve      = 0;
$mimefound    = 0;
$MAILING_LIST = "";


sub load_email_db($)
{
    my ($file) = @_;
    my @retlist;

    $DEBUG && print("debug: load_email_db '$file'\n");
    if (-f "$file") {
        open(load_email_fp, $file) || die "opening approved email list <$file>";
        while (<load_email_fp>) {
            chop;
            push(@retlist, $_);
        }
    }
    return @retlist;
}


sub search_approved_db($$@)
{
    my ($search_type, $addr, @list) = @_;

    for $pattern (@list) {
        $DEBUG && print("debug: $search_type <$addr> <$pattern>\n");
        $_ = "$addr";
        if (/^$pattern$/i) {
            return 1;
        }
    }
    return 0;
}


# --- main ---


open(FP, ">/tmp/approved_$$") || die("failed opening mail buffer file");
$SMDEBUG && (open(MAILFP, ">/tmp/sendmail.txt") || 
             die("failed opening sendmail file"));

while (<STDIN>) {
    $line = $_;
    $SMDEBUG && print MAILFP;
    if (/^from /i) {
        # 99.9999% of valid e-mails start with this at the beginning.
        # This is the top anchor for the header section of the message.
        #
        $mimefound = 10;
    }
    if (/^from: .*/i) {
        ($addr = $_) =~ s/from: //i;
        $addr        =~ s/.*<//;
        $addr        =~ s/[<>]//g;
        chop $addr;
        $DEBUG && print("debug: from found <$addr>\n");
        $from = 1;
    }
    if ($to == 0 && /^to: .*/i) {
        ($TO_ADDR = $_) =~ s/to: //i;
        $TO_ADDR        =~ s/.*<//;
        $TO_ADDR        =~ s/[<>]//g;
        $MAILING_LIST   =  $TO_ADDR;
        $MAILING_LIST   =~ s|@.*||;
        chop $MAILING_LIST;
        $PATH_MAILING_LIST = "$APPROVED_DB_DIR/$MAILING_LIST";
        $DEBUG && print("debug: mailing_subscriber is " .
                        "<$APPROVED_DB_DIR/$MAILING_LIST>\n");
        @subscrib    = load_email_db("$PATH_MAILING_LIST");
        $subscribok  = search_approved_db("subscriber", $addr, @subscrib);
        $DEBUG && print("debug: subscribok '$addr'=$subscribok\n");
 
        # Pull in mailing list configuration; APPROVED_STRING is in here.
        #
        $DEBUG && print "debug: List configuration ${PATH_MAILING_LIST}.cf\n";
        if (-f "${PATH_MAILING_LIST}.cf") {
            require("${PATH_MAILING_LIST}.cf");
        }
        @list     = load_email_db("${PATH_MAILING_LIST}.approved");
        $approved = search_approved_db("approved", $addr, @list);
        $approve  = $approved;
        $DEBUG && print("debug: approve = <$approve>\n");
        $to = 1;
    }

    # $mimefound is used as a state machine variable. "11" is the end state
    # where the approved password line is emitted once.  The states leading
    # up to "11" are searching for patterns in the message that indicate the
    # mail is plain text, or was converted to plain text, and that the
    # beginning of the body of the e-mail has been found.
    #
    if ($mimefound == 0 && /^Content-Type: TEXT\/PLAIN/i) {
        $mimefound = 10;
    }
    if ($mimefound == 0 &&
        /^X-Converted-To-Plain-Text: from multipart\/alternative by demime/i) {
        $mimefound = 1;
    }
    if ($mimefound == 1 &&
      /^X-Converted-To-Plain-Text: Alternative section used was text\/plain/i) {
        $mimefound = 10;
    }
    if ($mimefound == 10 && /^$/) {
        #
        # Found beginning of e-mail body here!
        #
        $mimefound = 11;
        $DEBUG && print("debug: start of e-mail body found $mimefound\n");
    }
    if (/^subject: .*/i) {
        $subj = 1;
    }
    if ($from && $to && $subj && $approved == 0 && /^approved: .*/i) {
        # The message already contains the "approved: password"
        #
        $DEBUG && print("debug: message has approved: already\n");
        $approved   = 1;
        $subscribok = 1;
        $mimefound  = 9999;
        print FP $line;
        print FP "\n";
    }
    elsif ($mimefound == 11) {
        # Append a newline to end of line if not newline terminated.
        #
        $_ = $line;
        (!/\n$/) && s/$/\n/;
        if ($subscribok == 0) {
            # Log attempted posting as a bounce, eat rest of the
            # message, and quit with a failed exit status.
            #
            open(LOGFP, ">>$BOUNCED_LOG_DIR/approved_denied.log");
            $date = &ctime(time);
            print(LOGFP "Bounced: To: $MAILING_LIST; " .
                        "From: <$addr> $date\n");
            close LOGFP;
            $DEBUG && print("debug: subscriber '$addr' " .
                            "not found in subscriber list\n");
            while (<STDIN>) {
                ;
            }
            close FP;
            $SMDEBUG && close MAILFP;
            $SMDEBUG || unlink("/tmp/approved_$$");
            exit(1);
        }
        elsif ($approve == 1) {
            # Print Subject line first...
            print FP;
    
            # Now approval string...
            print(FP "$APPROVED_STRING");
            $approve++;
            $mimefound = 9999;
        }
        else {
            # Message is not approved, so pass through and let Majordomo
            # bounce it without approval.

            # Print Subject line first...
            print FP;
            $mimefound = 9999;
        }
    }
    else {
        # Scrub line for approved: pattern.  Since we already emitted
        # this, don't emit this again as this would risk revealing
        # the password to the mailing list.  This edit is slightly dangerous,
        # as any line containing "approved:" in the e-mail will disappear.
        # Maybe search for "^approved:" is a little better?
        if (/approved: /i) {
            print FP "";
            $_ = "";
        }
        else {
            print FP $line;
        }
    }
}
close FP;
$SMDEBUG && close MAILFP;

open(FP, "/tmp/approved_$$") || die("failed opening mail buffer file");
while(<FP>) {
    print;
}
close FP;
$SMDEBUG || unlink("/tmp/approved_$$");
exit(0);