THIS IS OBSOLETE!

Use pemf!

http://MarginalHacks.com/Hacks/pemf


#!/usr/bin/perl
# Program:	mf
# Author:	David Ljung <http://davesource.com>
# Install:	Make a gobally readable .forward file in your home directory containing:
#		"|/path/to/mf"
# Credit:	Originally lifted from mailfilt by Michael Fisk
#		(http://www.nmt.edu/~mfisk/mailfilt.html)
use strict;

# TODO:
# Clean logs on occasion
# Add PGP support

##################################################
# Personal info (you will need to change this)
##################################################
my $ME = "Dave";
sub auto_respond_from {		# Who should we send mail from, based on "To:"
  my ($addr) = @_;
  return $addr if grep($addr =~ /$_/,
	# List addresses that go to specifically you:
	qw(
	));
  # And a default address here
  "autorespond\@some_domain_I_own.com";
}

# Addresses I own that receive loads of spam
#   These addresses were sold and receive pretty much only receive spam
my @SPAM_TO = qw(
	webmaster@
	ispaccess@techie.com
	dxt@davedomain.com

	broademails
	@post.com
	);

# Common spammers
my @SPAM_FROM = qw(news?picks@ @mailpride @safe-bill @paid4survey verticalresponse.com @thetravelclub @firesale.com compu-zilla.com 163.net lisa.caterson@mail.com);

# Messages that go to SPAM_TO from these addresses are *NOT* spam:
my @NOTSPAM_FROM = qw(
	dhs-club
	dotster registerapi.com
	);

# Common spam subjects?  (regexps)
#     See: http://www.annexia.org/spam/files-index.html
my @SPAM_SUBJECTS = (
	#"contest confirmation",
	#"think about this\.\.",
	"^ADV:",
	"Got Debt\?",
	"Get listed 10 Major Engines",
	"(?i)programmers available now\!",
	"(?i)low cost merchant accounts",
	"(?i)Expand Your Business",
	"(?i)Double Your Sales",
	"(?i)advertise .* for free",
	"(?i)free.*motorola.*pager",
	"(?i)find.*missing.*people",
	"(?i)free.*satellite.*t.v.",
	"(?i)protect computer data",
	# This is a weird one, I've seen lots of spam that is just 2-4 words
	# and is followed by #<4-digit hex num>.   I've constrained this
	# regexp so much because I don't want to catch legit email
	'(\w+\W){2,4}#[A-F0-9]{4}$',
	);

#########################
# Program name
#########################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

#########################
# User/home directory
#########################
my ($USER,$HOME,$HOST) = (getpwuid($>))[0,7];
Die("Can't get home directory\n") if (! ($HOME = (getpwuid($>))[7]));
chomp($HOST =`hostname`) if (! ($HOST = $ENV{'HOST'}) );

#########################
# Path settings
#########################
$ENV{PATH}	= "/bin:/usr/local/bin:/usr/bin:$HOME/bin";
$ENV{PGPPATH}	= "$HOME/.pgp";

#########################
# Where is our mail?
#########################
my $INBOX	= -d "/var/spool/mail" ? "/var/spool/mail/$USER" : "/usr/mail/$USER";
# And where do we save it?
my $BASE	= "$HOME/Mail";	       

#########################
# LOGGING
#########################
# mf logging of all messages goes here with -l option
my $LOG 	= "$BASE/mf.log";

#########################
# Save inbound mail?
#########################
my @TIME	= localtime(time);

# Set to 0 if you don't want to save inbound mail
#   I want to save to a new file every four months
#my $INBOUND	= sprintf("$BASE/INBOUND/%d.%0.2d",$TIME[5]+1900,int($TIME[4]/4)*4+1);
#   Nope - make it every month - these files are big
my $INBOUND	= sprintf("$BASE/INBOUND/%d.%0.2d",$TIME[5]+1900,$TIME[4]+1);

# Number of message (body) lines to save?
# (Set to -1 to save unlimited lines)
my $INBOUND_LIMIT	= 100;

#########################
# Global message filtering
#########################
my $MIME_SUCKS	= 1;	# Filter out mime-version header
my $URGENT_SUCKS = 1;	# Filter out urgent priority
my $STRIP_PGP = 1;	# Filter out PGP signatures

#########################
# Where is sendmail?
#########################
my $SENDMAIL	= "/usr/bin/forge_pipe";  # See http://MarginalHacks.com/#forge
   $SENDMAIL	= "/usr/sbin/sendmail" if (! -x $SENDMAIL);
   $SENDMAIL	= "/usr/lib/sendmail" if (! -x $SENDMAIL);
   $SENDMAIL	= "/usr/bin/sendmail" if (! -x $SENDMAIL);

##################################################
##################################################
# Be wary, all ye who enter here...
##################################################
##################################################

# Check args, handle logging
while (my $arg=shift(@ARGV)) {
  if ($arg =~ /^-l$/) {
    open(STDERR,">>$LOG") || Die("Can't open logfile [$LOG]\n");
    next;
  }
  if ($arg =~ /^-spam$/) { $MAIN::IS_SPAM=1; next; }
  die("[$PROGNAME] Unknown option: $arg\n");
}

#########################
# Read in headers
#########################
sub read_headers {
  my (@hdrs,%hdrs,$hdr);

  my $found_body=0;
  while (<>) {
    if (/^\s*$/) {
      # Done with headers
      # Set up 'rcpt' key
      my @rcpt;
      add_list($hdrs{'to'},\@rcpt);
      add_list($hdrs{'cc'},\@rcpt);
      add_list($hdrs{'x_apparently_to'},\@rcpt);
      $hdrs{'rcpt'}=join(',',@rcpt);
      # And 'RCPT' key, which includes all the "Received: .. for <...>"
      add_list($1,\@rcpt) while ($hdrs{'received'} =~ /for\s+<([^>]+)>/g);
      $hdrs{'RCPT'}=join(',',@rcpt);
      $found_body=1;
      last;
    }

    # Add to headers array (text) and hash (for search)
    push(@hdrs,$_) unless ( ($MIME_SUCKS && /^mime-version:/i) ||
                            ($URGENT_SUCKS && /^priority:\s*urgent/i) );
    chomp;
    if ($. == 1 && /^From (.+)\s+(\S+\s+\S+\s+\d+\s+[\d:]+\s+\d+)\s*$/) {
      ($hdrs{'FROM'},$hdrs{'DATE'}) = ($1,$2);
    } elsif (/^(\S+):\s+(\S.*)$/) {
      # Normal header
      $hdr = lc($1);  my $val = $2;
      $hdr =~ s/-/_/g;
      $hdrs{$hdr}= $hdrs{$hdr} ? "$hdrs{$hdr}\n$val" : $val;
#      if ($hdr =~ /num.?loops/i && $val =~ /^\s*(\d+)\s*$/) {
#        # Num Loops header - increment
#        $hdrs{$hdr}=$1+1;
#        pop(@hdrs); push(@hdrs,"${hdr}: ".($1+1)."\n");
#      }
    } else {
      # Continuation of previous header
      s/^\s+/ /;
      $hdrs{$hdr}.=$_;
    }
  }

  print STDERR "-"x50,"\n";
  print STDERR "[Message with no body?]\n" if (!$found_body);
  print STDERR "From:    $hdrs{'from'} to $hdrs{'rcpt'}\n";
  print STDERR "Subject: $hdrs{'subject'} => ";
  return (\@hdrs,\%hdrs);
}

sub change_header {
  my ($h_L,$head,$str) = @_;
  for (my $i=0; $i<=$#$h_L; $i++) {
    $h_L->[$i] = "$1 $str\n" if $h_L->[$i] =~ /^(${head}:)/i;
  }
}

#########################
# Send a canned response to an email
#########################
sub add_list {
  my ($add,$arr) = @_;
  $add =~ s/\s+//g;
  push(@$arr,$add) unless !$add || grep(lc($add) eq lc($_), @$arr);
}

# So we can ignore mailer daemon bounces to auto replies
my $RESPOND_KEY = "[mf_resp]";

# Check headers and body for auto response indicators
sub is_auto_respond {
  my ($h_H,@body) = @_;
  ($h_H->{'Subject'} =~ /\Q$RESPOND_KEY\E/ ||
   grep(/X-MFLoop-Cnt/, @body) ||
   grep(/\Q$RESPOND_KEY\E/, @body)) ? 1 : 0;
}

sub auto_respond_mail {
  my ($hdrs_H,$subject,$message) = @_;

  # Who do we reply to?
  my @reply;
  add_list($hdrs_H->{'FROM'}, \@reply);
  add_list($1, \@reply) if ($hdrs_H->{'reply_to'} =~ /^([^<]+@\S+\.[^<]+)$/);
  add_list($1, \@reply) if ($hdrs_H->{'reply_to'} =~ /<([^<\s]+@[^<\s]+\.[^<\s]+)>/);
  add_list($1, \@reply) if ($hdrs_H->{'received'} =~ /sent by <([^>]+)>/);
  add_list($1, \@reply) if ($hdrs_H->{'from'} =~ /^([^<]+@\S+\.[^<]+)$/);
  add_list($1, \@reply) if ($hdrs_H->{'from'} =~ /<([^<\s]+@[^<\s]+\.[^<\s]+)>/);
  my $reply = join(',',@reply);

  # Who do we claim the message is from?
  my $from = auto_respond_from($hdrs_H->{'to'});
  $from=$1 if $from =~ /<(.+)>/;	# Just the email address
  $from=$1 if $from =~ /^([^\s,]+)[\s,]/;
  my $from_full = "${ME}'s Auto Responder";

  my $loop = $hdrs_H->{'x-mfloop-cnt'} + 1;

  return unless open(RESPOND,"|$SENDMAIL -i -f \"$from\" -F \"$from_full\" $reply");
  print RESPOND <<RESPOND_MESSAGE;
From: $from_full <$from>
Subject: $RESPOND_KEY $subject
To: $reply
X-Mailer: $PROGNAME
X-MFLoop-Cnt: $loop
In-Reply-To: $hdrs_H->{'message-id'}

$message

RESPOND_MESSAGE
  close(RESPOND);
}

#########################
# Write the mail somewhere
#########################
sub send_die {
  my ($box,$hdrs_L,$msg) = @_;
  # Try a send_to if possible
  Die($msg) if (!$box);
  print STDERR "$msg\n";
  print STDERR "Attempting default box\n";
  send_to(0,$hdrs_L);
}
sub send_to {
  my ($box,$hdrs_L,$clean_equals,$persist) = @_;

  my ($lock,$remail,$lines)=(0,0,0);

  #########################
  # Open up INBOUND
  #########################
  my $inbound = 0;
  $INBOUND = 0 unless $hdrs_L;
  if ($INBOUND && open(INBOUND,">>$INBOUND")) {
    if (flock(INBOUND,2)) {
      $inbound = 1;
    } else {
      print STDERR "Inbound flock failed: [$!]\n";
    }
  }

  #########################
  # Open the box
  #########################
  if ($box =~ /^\|(.+)/) {
    # Command
    my $pipe=$1;
    print STDERR "command [$pipe]\n";
    $pipe =~ /^(\S+)/; send_die($box,$hdrs_L,"Can't find command [$1]") if (! -x $1);
    open(FOLDER,"|$pipe") || send_die($box,$hdrs_L,"Can't run [$pipe]");
  } elsif ($box =~ /\@/) {
    # Address
    print STDERR "remail [$box]\n";
    open(FOLDER,"|$SENDMAIL $box") || send_die($box,$hdrs_L,"Can't run sendmail to [$box]");
    $remail=1;
  } else {
    # File
    $box=$INBOX if (!$box);
    $box="$BASE/$box" if ($box !~ m|^/|);
    print STDERR "file [$box]\n";

    # Lock
    while(-e "$box.lock") { sleep 1; }
    open(LOCK,">$box.lock"); print LOCK $$; close LOCK;
    open(FOLDER,">>$box") || send_die($box,$hdrs_L,"Can't open $box.");
    flock(FOLDER,2) || print STDERR "Flock failed: [$!]\n";
    $lock=1;
    seek(FOLDER,0,2) || print STDERR "Seek failed [$!]\n";
    select((select(FOLDER), $|=1)[0]);	# Don't buffer box
  }

  #########################
  # Write it
  #########################
  print FOLDER @$hdrs_L,"\n" if $hdrs_L;
  print INBOUND @$hdrs_L,"\n" if $inbound;
  $lines=@$hdrs_L+1 if ($hdrs_L);
  if ($remail) {
    print FOLDER "X-Forwarded-By: $USER\@$HOST\n";
    print FOLDER "X-Filter: $PROGNAME\n";
  }
  my $pgp;
  while(<>) {
    print INBOUND if ($inbound && ($INBOUND_LIMIT==-1 || $.<=$INBOUND_LIMIT));

    # START PGP
    if (/^-+BEGIN PGP SIGNED/) {
      $pgp++;
      if (!$STRIP_PGP && !open(PGP,"|pgp -f >/tmp/mailfilt.$$.$pgp 2>&1 >/dev/null")) {
        warn "PGP: $!";
        $pgp--;
      }
    }
    # IN PGP
    if ($pgp) {
      $STRIP_PGP || print PGP || warn $!;
      if (/^-+END PGP/) {
# Blah - need to fix this
        print FOLDER "----- $PROGNAME [pgp]: 0\n" || warn $!;
        $pgp--;
      }

    # NORMAL MAIL TEXT
    } else {
      # Clean equals?
      if ($clean_equals) {
        chomp, chop if (/=$/);
	# Non =escapes, but probably just as unreadable
	s/\x92/'/g;
        s/\x93/"/g;   # double left quote  ``?
        s/\x94/"/g;   # double right quote ''?
        s/\x96/--/g;  # em-dash

	# =escapes
        s/=(20|0D|85|96)//g;	# LF, CR, ??, ??
        s/=91/`/g;  s/=92/'/g;	# Quotes
        s/=93/  /g; s/=94/\n    /g;	# <p> and </p>
        s/=97/ /g;		# ??
        s/=B7/-/g;		# '·' doesn't show up with less
        while (/=([0-9A-F]{2})/) {
          my $c=sprintf("%c",hex($1));
          s/=$1/$c/g;
        }
      }
      print FOLDER || warn $!;
    }

    $lines++;
  }
  print FOLDER "\n" if (!/^\s*$/);
  print FOLDER "\n";
  print INBOUND "\n" if ($inbound);

  #########################
  # Unlock and close it
  #########################
  !$inbound || flock(INBOUND,8) || print STDERR "Inbound unlock failure: $!\n";
  !$lock || flock(FOLDER,8) || print STDERR "Unlock failure: $!\n";
  my $err;
  close(FOLDER) || ($err = $!);
  unlink("$box.lock") if ($lock);
  send_die($box,$hdrs_L,$err) if ($err);

  print STDERR " [$lines lines]\n";
  exit unless $persist;
}

#########################
# Fatal
#########################
sub Die {
  $! = 75;
  foreach ( @_ ) { print STDERR "[$PROGNAME] $_\n"; }
  die("[$PROGNAME] ".$_[0]."\n");
}

##################################################
# Main
##################################################
sub main {
  $!="";
  my ($h_L,$h_H) = read_headers();

  # Infinite loop avoidance
  exit if ($h_H->{'x-mfloop-cnt'} > 5);		# Using my LOOP_CNT header
  exit if (grep(/^Received:/, @$h_L) > 200);	# More than 200 Received headers!

# Simple examples.  File, address, pipe
#  send_to("test",$h_L) if ($h_H->{'subject'} =~ /test/i);
#  send_to("root\@localhost",$h_L) if ($h_H->{'subject'} =~ /cron/i);
#  send_to("|/bin/cat",0) if ($h_H->{'subject'} eq "cat_me");

  ##################################################
  # Mailer Daemon
  ##################################################
# auto.reply@?  (compuserve uses that address with the name postmaster:)
  if ($h_H->{'FROM'} =~ /mailer.daemon/i || $h_H->{'from'} =~ /postmaster/i) {
    # See if it's just a spam bounce
    my @body = <>;
    if (is_auto_respond($h_H,@body)) {
      print STDERR "[bounced auto-respond] DELETED\n";
      exit;
    }
    push(@$h_L,"\n",@body);	# Cheat - just put the body in with the headers.
    # Save it in the default mailbox
    # No!  It may still be spam!
    #send_to(0,$h_L);
  }

  ##################################################
  # DaveRequest
  ##################################################
  # I send questions to this address to get short replies (for my cell phone)
  if ($h_H->{'RCPT'} =~ /question\@daveola.com/) {
    #$INBOUND = 0;	# Don't save these

    my $answer = `ask_question $h_H->{subject}`;
    change_header($h_L,'subject',"[QUESTION] $h_H->{subject}");
    auto_respond_mail($h_H,"answer",$answer);
  }

  ##################################################
  # RESUME/HEAD HUNTER
  ##################################################
  if ($h_H->{'subject'} !~ /(CONTACT REQUEST|RECRUITER RESPONSE)/i &&
      $h_H->{'RCPT'} =~ /resume\@daveola.com/i) {
    $INBOUND = 0;	# Don't save this crap in my INBOUND

#-------------
    auto_respond_mail($h_H,"RECRUITER RESPONSE [re: $h_H->{'subject'}]",<<END_MESSAGE);

You mailed me at my resume address, which can only be found at my online resume:

  http://Daveola.com/Pages/Resume/

This page clearly states:

  I am currently very happy at my current company and not looking for a job.

  Unless you intend to allow me to bring my dog to work, give me a 
  window office and either give me a job in San Francisco or allow me 
  to regularly telecommute, then I am not currently looking for a job, 
  and I don't know anyone who is.

If you still need to contact me, you can respond to this message
with the subject:  "CONTACT REQUEST"

Original message stats:
From:     $h_H->{'FROM'}
Date:     $h_H->{'DATE'}
Subject:  $h_H->{'subject'}

END_MESSAGE
#-------------

    print STDERR "Resume mailing\n";
    send_to("recruiters",$h_L);
  }

  ##################################################
  # SPAM
  ##################################################
  my $is_spam = $MAIN::IS_SPAM;

  # Spam triggers (use "$is_spam ||" for efficiencies sake)
  $is_spam = $is_spam || $h_H->{'from'} eq "";
  $is_spam = $is_spam || $h_H->{'from'} eq "<>";
  $is_spam = $is_spam || grep($h_H->{'RCPT'} =~ /$_/i, @SPAM_TO);
  $is_spam = $is_spam || grep($h_H->{'FROM'} =~ /$_/, @SPAM_FROM);
  $is_spam = $is_spam || grep($h_H->{'subject'} =~ /$_/, @SPAM_SUBJECTS);
  #$is_spam = $is_spam || $h_H->{'received'} =~ /may be forged/i;
  #$is_spam = $is_spam || $h_H->{'received'} =~ /from \.{20}/;	# Specific spammer

  # Special, non-spam cases
  $is_spam = 0 if ($h_H->{'subject'} =~ /(CONTACT REQUEST|SPAM WARNING)/i);
  $is_spam = 0 if (grep($h_H->{'FROM'} =~ /$_/, @NOTSPAM_FROM));

  if ($is_spam) {
    $INBOUND = 0;	# Don't save this in my INBOUND

#-------------
    auto_respond_mail($h_H,"SPAM WARNING - REMOVE [re: $h_H->{'subject'}]",<<END_MESSAGE);

My automated mail filter determined that email you sent me was
unsolicited commercial email ("spam")

From:     $h_H->{'FROM'}
Date:     $h_H->{'DATE'}
Subject:  $h_H->{'subject'}


IF THE MAIL YOU SENT WAS NOT SPAM:

  Many apologies for the error!  My filter software is not perfect!
  I have saved (but not read the mail you sent).  You can send me a new
  mail with the subject "CONTACT REQUEST" asking me to read the original,
  and I'll try to fix whatever caused the email to get flagged as spam.

IF THE MAIL YOU SENT WAS SPAM:

  This is in violation of state law because it violates
  the Terms Of Use of my mail server:  http://Daveola.com/Terms/

  Do not *ever* mail me again.

END_MESSAGE
#-------------

    print STDERR "Determined to be SPAM\n";
    send_to("SPAM",$h_L);
  }


# Tmp - send mail from bchoy or dobrikin to my cell phone
#  if ($h_H->{'from'} =~ /(bchoy|dobrikin)/) {
#    my @body = <>;
#    push(@$h_L,"\n",@body);	# Cheat - just put the body in with the headers.
#    send_to("4159393283\@mobile.att.net",$h_L,0,1);
#  }

  # Send network alerts to my cell
  if ($h_H->{'from'} =~ /\@.*netmon.com/ &&
      $h_H->{subject} =~ /^(CRITICAL|OK) alert for up/) {
    my @body = <>;
    push(@$h_L,"\n",@body);	# Cheat - just put the body in with the headers.
    send_to("4159393283\@mobile.att.net",$h_L,0,1);
  }

#  ##################################################
#  # Filter for non-work email to send *copies* to public email
#  ##################################################
#  if ($h_H->{'FROM'} !~ /\@transmeta/ || $h_H->{'subject'} =~ /sweden/i) {
#    my @body = <>;
#    push(@$h_L,"\n",@body);	# Cheat - just put the body in with the headers.
#    send_to("dave_ljung\@yahoo.com",$h_L,0,1);
#  }

  ##################################################
  # Example email remote control
  ##################################################
  #send_to("|/home/madison/bin/wango",0) if ($h_H->{'subject'} eq "wongo");

  ##################################################
  # Ignore quoted printable crap
  ##################################################
  send_to(0,$h_L,1) if ($h_H->{'content-transfer-encoding'} =~ /quoted.*printable/i);

  ##################################################
  # Default MBOX
  ##################################################
  send_to(0,$h_L);
} main();