#!/usr/bin/perl

# (C) 1996-2000 Steven Zeck <saintly@innocent.com>
# Free software, modify at your own risk.  Send questions about
# the _ORIGNAL, UNMODIFIED_ source to the address above.  Any
# modifications must contain this notice and contain the attribution
# line.  Free for any use, including commercial institutions as long
# as no profit is made directly from use of this software or any
# of it's derivative works.
# Any person making modifications must also put their e-mail address
# on a comment line following this one before re-distributing.

# Hall O' Modifiers:
# (none so far, but take this line out and put your eMail address here)
#
#

# This whole thing should be nicely documented.  If you have
# a problem understanding something, you might consider eMailing
# me, unless someone else has maliciously stolen the credit for
# writing it, then eMail them.  Don't eMail me before reading the
# docs and at least looking around near where you have a problem.
# I'll ignore you.  

# Program identification information
$version  = "2.8a";
#$released = "Mar 25, 1997";
$released = localtime(time);

######################################################################
# The ONLY really potential user-configurable stuff is here unless
# you really want to play with the code. 
# Most of these defaults can be set in the config file

# Set main vars. to defaults.
&reset_user($>);

# Don't forward or send canned to these addresses or w/ these subjects
@no_resp_from = ("serv\$", "server", "daemon", "root");
@no_resp_subj = ("server", "serv\$", "automated", "filter");
# Commands that should care about it.
@no_resp_cmds = ("bounce","canned","forward","mail");

# Command aliases.  Command on left replaced with command on right.
@cmd_aliases = ("ignore:leave",   "annotate:addheader","strip:remheader",
		"keep:keepheader","translate:xlate",   "tr:xlate",
		"run:execute",    "write:saveover",    "purify:xheader",
		"pass:xcontent",  "feed:xmessage",     "protect:mode",
		"require:load",	  "get:load",          "subst:replace",
		"rem:comment",    "log:comment",       "#:comment",
		"biff:page",	  "annoy:page",        "resultto:mailresult",
		"result:mailresult", "select:during",  "rbl:dnsbl");

# Basic files (can't be changed by "set", but can be set on command line)

$mail_prog     = sprintf("/usr/sbin/sendmail");
$news_prog     = sprintf("/usr/contrib/lib/news/inews");

# ZFilter's default location if it can't find itself.  This is 
# initially set to "/usr/local/bin" which will probably be wrong, 
# since it checks that directory when it is trying to find itself.
$default_loc   = "/usr/local/bin";	

# Spit something descriptive at PS
$zero = $0; $0 = "Mail ZFilter";

# Mode for creating dbm files and folders
$PMODE = 0600; umask 0;

# Set this to "0" to disable flock(2) for file-locking 
# (Zfilter will use an internal method)
$USE_FLOCK = 1;

# For the internal file-locking mechanism
$LOCK_ATTEMPTS = 22; # Number of attempts to make to open a file if locked
$LOCK_INTERVAL = 3;  # Number of seconds between attempts

# ZFilter's subject line for panic error messages
$ERR_MSG_SUBJ = "ZFilter mail delivery error";

# Panic Level - what happens when we can't save the message
# Level 1 - send error message reply to sender about it
# Level 2 - send error message reply to local postmaster too
# Level 3 - send error message reply to postmaster at sending site
# Level 4 - send error message reply to user (probably won't work)
# Panic Levels are cumulative!  
$PANIC_LEVEL = 1;

# Defaults for variables.  If you add a MAILENV key and var here,
# Zfilter will give the user a chance to define it themselves in
# setup (zfilter -c)  
# DON'T play with the key names unless you REALLY want to change it
# everywhere else too.  These are all used quite a bit.
$MAILENV{'rules_file'} = ".zfrules";
# Inbox by &reset_user function
#$MAILENV{'inbox'} = sprintf("/var/mail/%s",$uname);
$MAILENV{'log_file'} = "filter-log";
$MAILENV{'mail_subj'} = "ZFilter Mail";
$MAILENV{'fwd_mail_subj'} = "ZFilter Forwarded Mail";
$MAILENV{'list_mail_subj'} = "ZFilter List Mail";
$MAILENV{'local_host'} = "";
# Base dir by &reset_user function
#$MAILENV{'base_dir'} = sprintf("%s/", $udir);
$MAILENV{'chain_threshold'} = 30;
$MAILENV{'list_dir'} = $list_dir;
$MAILENV{'mail_prog'} = "";
$MAILENV{'news_prog'} = "";

# End of potentially user-configurable stuff
######################################################################

# Secret dbm filter-summary files.  Can't change 'em and you're not
# even supposed to know about them.  Now I'll have to kill you.
# (Actually, you're welcome to change them here, but you can't
#  specify these on the command line)
$act_summary   = ".zfilter-asum";
$mail_summary  = ".zfilter-msum";

if($USE_FLOCK) { $LOCK_EX = 2; $LOCK_UN = 8; }

# Set signal handling
$SIG{'HUP'}  = 'sig_handler';  # nice exit, dump message
$SIG{'INT'}  = 'sig_handler';  # nice exit, dump message
$SIG{'QUIT'} = 'sig_handler';  # nice exit, dump message
$SIG{'ABRT'} = 'sig_handler';  # delete locks, exit, don't dump message
$SIG{'TERM'} = 'sig_handler';  # nice exit, dump message
$SIG{'ALRM'} = 'sig_handler';  # abort attempt to flock, forget opening file
$SIG{'KILL'} = 'sig_handler';  # As if.  :)
$SIGALRM_SET = 0;          # Don't mess with it!

@ERRORS = ();

# Find out what the program is called at the moment.
# Shame on you if you've renamed it from "Zfilter"!
if( $zero =~ /^.*\/(.*)$/ ) { $exec_prog = $1; }
else { $exec_prog = $zero; }

$exit = &parse_mode;	# Parse command-line args
&load_defaults;         # Get defaults from file (if it exists)

# Switch off if command-line args dictate it
if( $MODE{'config'} )    { &setup; }
if( $MODE{'clear_log'} ) { &clear_log; } 
if( $MODE{'viewlog'} )   { &pr( &real_file($MAILENV{'log_file'}) ); }
if( $MODE{'viewrules'} ) { &pr( &real_file($MAILENV{'rules_file'}) ); }
if( $MODE{'summary'} )   { &summary; }
if( $MODE{'version'} )   { &version; }
if( $MODE{'reset_sum'} ) { &reset_sum; }
if( $MODE{'reset_all'} ) { &reset_all; }
if( $MODE{'usage'} ) { &usage; }
if( $MODE{'addlist'} ) { &add_list($MODE{'addlist'}, $WHO); }
if( $MODE{'dellist'} ) { &del_list($MODE{'dellist'}, $WHO); }
if( $MODE{'prnlist'} ) { &print_list($MODE{'prnlist'}); }
if( $MODE{'whatlists'} ) { &what_lists($MODE{'whatlists'}); }

if($exit) { exit; }

&load_permanents; 	# Get the permanent variables

@ORG_MSG = <ARGV>;	# Load the message from stdin
&parse_msg; 		# Parse message header and message.

if(! $MAILENV{'real_sender'}) { 
	die "Doesn't appear to be a mail message!  Dead ";
} 

&do_extras;		# And make the nice extra vars. from the read-in ones

# Grab the ".signature" file
&zopen(SIG, &real_file(".signature"));
while(<SIG>) { $MAILENV{'signature'} .= $_; }
&zclose(SIG);

if(! -r &real_file($MAILENV{'rules_file'}) ) { 
   &save_to("$MAILENV{'inbox'}"); exit; 
}

# Start logging:
if( !($MODE{'actions_only'}) ) {
  &log( "Mail from $MAILENV{'real_sender'} about $MAILENV{'subject'}" );
}

$last_ok = 1; $save_at_end = 1; $some_action = 0;
&read_rules($MAILENV{'rules_file'});

sub read_rules {
  local($rules_file) = @_;
  $rules_file = &real_file($rules_file);
  local($rule, $line, $expr, $actions, $rulenum, $test);

  foreach $test (@RULES_FILES) {
    if( $test eq $rules_file ) { 
     &log("  ${indent}Can't read rules file \"$rules_file\".  It is already in use.");
     return 1;
    }
  }
  push(@RULES_FILES, $rules_file);

  if(!&zopen( FH_RULEFILE, $rules_file) ) { return 0; }
  local(@RULES) = <FH_RULEFILE>;
  &zclose( FH_RULEFILE );

  # Rules file loop.
  foreach $rule (@RULES) {
    if( !(($rule =~ /^#/) || $DIE ) ) {			      # if
     if( ! $DIE && 
	   (($rule =~ /^\s*if\s*\(([^)]*)\)\s*(.*)$/i) ||
            ($rule =~ /^\s*if\s+(.*)\s+then\s+(.*)$/i)) ) {
      $expr = $1; $actions = $2; $rulenum++; $line++;
      if( &true_expr( $expr ) ) { 
         &take_action( $actions ); 
         $last_ok = 1; $some_action = 1;
      } else { 
         $last_ok = 0; 
      }
     } elsif( !$DIE && 					      # else if
              (($rule =~ /^\s*else?\s*if\s*\(([^)]*)\)\s*(.*)$/i) ||
               ($rule =~ /^\s*els?e?\s*if\s+(.*)\s+then\s+(.*)$/i)) ) {
      $expr = $1; $actions = $2; $rulenum++; $line++;
      if(!$last_ok && &true_expr( $expr ) ) {
        &take_action( $actions );
        $last_ok = 1; $some_action = 1;
      }  
     } elsif( !$DIE && ($rule =~ /^\s*else\s+(.*)$/i) ) {     # else
      $actions = $2; $rulenum++; $line++;
      if(!$last_ok) {
        &take_action( $actions );
        $last_ok = 1; $some_action = 1; 
      }
     } elsif( !$DIE && $last_ok ) { 
          &take_action( $rule ); $some_action = 1; $line++; 
     }
    }
  }
}

# If no actions were taken, save to inbox.
if (! ( $some_action ) || $save_at_end ) {
   &save_to("$MAILENV{'inbox'}") if ! $MODE{'no_action'};
   &log(  "Saved to mailbox (by default) - no actions taken." ) if
	 (! ($some_action) );
   # &log("Savedit");
}

if( !( $MODE{'no_action'} ) ) {
   &save_permanents;	# Can't be losing /them/ now, can we?
}

################################################################################
# Subs for actions, parsing if (???) expressions                              
#
################################################################################

# ACTIONS AVAILABLE:
# delete, savecopy, save (savecopy+delete), execute, forward, leave | ignore
# canned, stop, set, pipe, pipecontent, mail, bounce, name, setheader
# addlist, remlist, maillist, addheader, remheader, take, keepheader, xlate
# create, zap, inc, dec, pinc, pdec, post, process, saveover, comment
# xheader, xcontent, xmessage, resync, umask, mode, unique, do, load, quote
# mailresult, nop, at, after, during

sub take_action {
    local($expr) = @_;
    local($command, $cmd, @cmds, $val, $ACTION, $alias, $a, $b); 
    local(@TEMP, $word, @all);
    local($DONT) = $MODE{'no_action'};
    @cmds = split(/; */, $expr);
    foreach $cmd (@cmds) {

        @TEMP = (); @all = ();
	# Second gen. command parser!  :) 
	# Find, and parse out quoted text
	while( $cmd =~ /\"([^"]*)\"/ ) {
  	  $a = $1; push( @TEMP, $a ); $b = "\"$a\"";
  	  $cmd =~ s/$b/ _#_ /;
	}
	# Put it back, w/variable interpolation
	foreach $word (split(/\s+/, $cmd)) {
  	  if( $word eq "_#_" ) { push(@all, shift(@TEMP)); }
	  elsif( $word =~ /^\?(.+)$/ ) { push(@all, $MAILENV{$1}); }
  	  else { push(@all, $word); }
	}

	$command = shift(@all); 
        if($command =~ /\s/) {
	  @all = (split(/\s+/, $command), @all);
	  $command = shift(@all);
	}
	$arg = shift(@all); $command =~ tr/A-Z/a-z/; 
	$real_arg = &real_file($arg); $ACTION = "";

	# Aliased commands
	foreach $alias (@cmd_aliases) {
	  ($a, $b) = split(/:/, $alias);
	  if($command eq $a) { $command = $b; }
	}
	
	if ( &dont_respond && ! &respond_ok ) {
	  $ACTION = "Can't \"$command\" to this message possibly from another filter.";
	} elsif( $command eq "addheader" ) {
	  $val = join(" ", @all);
	  $ACTION = "Added header variable \"$arg\" with \"$val\".";
	  &add_header("$arg: $val\n") if ! $DONT;
	} elsif( $command eq "addlist" ) {
	  $ACTION = "Added $MAILENV{'real_sender'} to list \"$arg\".";
	  &add_list($arg, $MAILENV{'real_sender'}) if ! $DONT;
        } elsif( $command eq "after" ) {
          $arg = &real_time($arg);
          $val = join(" ", @all);
          $ACTION = "Delayed command \"$val\" until after " . localtime($arg) . ".";
          &run_later($arg,$val) if ! $DONT; 
        } elsif( $command eq "at" ) {
          $arg = &real_time($arg); if($arg < time) { $arg += 24*60*60; }
          $val = join(" ", @all);
          $ACTION = "Delayed command \"$val\" until " . localtime($arg) . ".";
          &run_later($arg,$val) if ! $DONT; 
	} elsif( $command eq "bounce" ) {
	  $ACTION = "Bounced to \"$arg\".";
	  &mail($arg, $MAILENV{'fwd_mail_subj'},@ORG_MSG) if ! $DONT;
	  $save_at_end = 0 if ! $DONT;
	} elsif( $command eq "canned" ) {
	  $ACTION="Sent canned reply \"$arg\" to $MAILENV{'real_sender'}.";
	  &mail_canned($real_arg, $MAILENV{'real_sender'}) if ! $DONT;
	} elsif( $command eq "comment" ) {
	  $arg = join(" ", $arg, @all);
	  $ACTION=$arg;
	} elsif( $command eq "create" ) {
	  $val = shift(@all);
	  $ACTION = "Created permanent variable: \"$arg\" = \"$val\".";
	  $PRMNT{$arg} = $val if ! $DONT; $MAILENV{$arg} = $val;
	} elsif( $command eq "dec" ) {
	  $ACTION = "Decremented \"$arg\".";
	  $MAILENV{$arg}--;
	} elsif($command eq "delete") {
	  $ACTION = "Deleted message.";
	  $save_at_end = 0 if ! $DONT;
	} elsif( $command eq "dnsbl" ) {
          $val = join(" ", @all); if(!$val) { $val = "delete"; }
          if( &check_dnsbl($arg) ) { 
            &take_action($val);
            $ACTION = "Message failed DNSBL check.";
          } else { $ACTION = ""; }
	} elsif( $command eq "do" ) {
	  $a = join(" ",@all);
	  $ACTION = "Ran internal routine \"$arg $a\".";
	  &$arg(@all);	
        } elsif( $command eq "during" ) {
          $a = shift(@all); $val = join(" ", @all);
          if( (&real_time($arg) < time) && (&real_time($a) > time) ) {
             $ACTION = "";
             &take_action($val);
          } else { 
             $ACTION = "Didn't execute timed command \"$val\".";
          }
	} elsif( $command eq "execute" ) {
	  $val = join(" ", @all);
	  $ACTION = "Executed command \"$arg $val\"";
	  &run_to("$real_arg $val") if ! $DONT;
	} elsif( $command eq "forward" ) {
	  $ACTION = "Forwarded to \"$arg\".";
	  &mail($arg,$MAILENV{'fwd_mail_subj'},@ORG_MSG) if ! $DONT;
	} elsif( $command eq "inc" ) {
	  $ACTION = "Incremented \"$arg\"."; 
	  $MAILENV{$arg}++;
	} elsif( $command eq "keepheader" ) {
	  unshift(@all, $arg);	
	  $ACTION = sprintf("Stripped header except for variables \"%s\".", join(",", @all));
	  &keep_header(@all) if ! $DONT;
	} elsif( $command eq "leave" ) {
	  $ACTION = "Saved to Inbox.";
	  $save_at_end = 1 if ! $DONT;
	} elsif( $command eq "load" ) {
	  $ACTION = "Loaded perl file \"$arg\".";
	  require($real_arg);
	} elsif( $command eq "mail" ) {
	  $val = shift(@all);
          $ACTION="Sent reply file \"$arg\" to $val.";
	  &mail_canned($real_arg,$val) if ! $DONT;
	} elsif( $command eq "maillist" ) {
	  $ACTION = "Mailed incoming message to list \"$arg\".";
	  &send_to_list($arg) if ! $DONT;
        } elsif( $command eq "mailresult" ) {
	  $ACTION = "Mailed output of last program to \"$arg\".";
 	  &mail_result($arg);
	} elsif( $command eq "mode" ) { 
	  $ACTION = "Set mode for saved folders to \"$arg\".";
	  $PMODE = $arg;
	} elsif( $command eq "name" ) {
	  $arg = join(" ",$arg, @all);
	  $ACTION = "Tagged message as coming from \"$arg\".";
	  &set_from($arg);
        } elsif( $command eq "nop" ) {
          $ACTION = ""; 
	} elsif( $command eq "page" ) {
	  $arg = join(" ",$arg, @all);
	  $ACTION = "Sent page \"$arg\".";
	  &page($arg);
	} elsif( $command eq "pdec" ) {
	  $ACTION = "P-Decremented \"$arg\".";
	  $PRMNT{$arg}-- if ! $DONT; $MAILENV{$arg}--;
	} elsif( $command eq "pinc" ) {
	  $ACTION = "P-Incremented \"$arg\".";
	  $PRMNT{$arg}++ if ! $DONT; $MAILENV{$arg}++; 
	} elsif( $command eq "pipe" ) {
	  $val = join(" ", @all);
	  $ACTION="Piped to command \"$arg $val\" ";
	  &run_through("$real_arg $val",@ORG_MSG) if ! $DONT;
	} elsif( $command eq "pipecontent" ) {
	  $val = join(" ", @all);
	  $ACTION="Piped message content to \"$arg $val\" ";
	  &run_through("$real_arg $val",$MAILENV{'content'}) if ! $DONT;
	} elsif( $command eq "post" ) {
	  $ACTION = "Posted message to newsgroup(s) \"$arg\".\n";
	  &post($arg) if ! $DONT;
	} elsif( $command eq "process" ) {
	  $ACTION = "(Processing different rules file \"$arg\")";
	  $READING++; &read_rules($real_arg); $READING--;
	} elsif( $command eq "quote" ) {
	  $ACTION = "Quoted variable \"$arg\"";
	  &quote_var($arg);
	} elsif( $command eq "remlist" ) {
	  $ACTION = "Removed $MAILENV{'real_sender'} from list \"$arg\".";
	  &del_list($arg, $MAILENV{'real_sender'}) if ! $DONT;
	} elsif( $command eq "replace" ) { 
	  $cmd =~ /^\s*\S+\s+\S+\s*(.*)$/; $val2 = $1;
	  $val = $all[0]; $val2 = $all[1];
	  $ACTION="Replaced \"$val\" with \"$val2\" in variable \"$arg\".";
	  $MAILENV{$arg} =~ s/$val/$val2/ge;
	} elsif( $command eq "resync" ) {
	  $ACTION="Resynchronized message header and variables.";
	  &resync_vars;
        } elsif( $command eq "save" ) {
	  $ACTION = "Saved to folder \"$arg\" and removed from inbox.";
	  $save_at_end = 0 if ! $DONT;
	  &save_to($arg) if ! $DONT;
	} elsif( $command eq "savecopy" ) {
	  $ACTION = "Saved copy to folder \"$arg\".";
	  $save_at_end = 1 if ! $DONT;
	  &save_to($arg) if ! $DONT;
	} elsif( $command eq "saveover" ) {
	  $ACTION = "Cleared folder \"$arg\" and saved copy to it.";
	  &zap_file($real_arg) if ! $DONT;
	  &save_to($arg) if ! $DONT;
	} elsif( $command eq "set" ) {
	  $val = join(" ", @all);
	  $ACTION = "Set \"$arg\" to \"$val\".";
	  if( ($arg eq 'base_dir') && !($val =~ /\/$/) ) {
		$val .= "/"; $val =~ s/\s+//g;
	  } 
	  $MAILENV{$arg} = $val;
	} elsif( $command eq "setheader" ) {
	  $val = join(" ", @all);
	  $ACTION = "Set header variable \"$arg\" to \"$val\".";
	  &set_header($arg, $val) if ! $DONT;
        } elsif( $command eq "stop" ) {
	  $ACTION = "Stopped processing.";
	  $DIE = 1;
	} elsif( $command eq "take" ) { 
	  $ACTION = "(Taking actions based on output of last command)";
	  $SUBBING++; &take_action($MAILENV{'result'});
	} elsif( $command eq "umask" ) {
	  $ACTION = "Set process umask to \"$arg\".";
	  umask $arg;
	} elsif( $command eq "unique" ) {
	  if(&unique($real_arg)) {
	     $ACTION = "(Unique) Saved copy to folder \"$arg\".";
	     &save_to($arg) if ! $DONT;
	  } else {
	     $ACTION = "(Content not unique)";
	  }
	} elsif( $command eq "xcontent" ) {
	  $val = join(" ", @all);
	  $ACTION="Passed message body to program \"$arg $val\" and replaced it.";
	  &get_content("$real_arg $val");
	} elsif( $command eq "xheader" ) {
	  $val = join(" ", @all);
	  $ACTION="Passed header to program \"$arg $val\" and replaced it.";
 	  &get_header("$real_arg $val");	
	} elsif( $command eq "xlate" ) {
	  $val = $all[0];
	  if($all[2]) { $a = $all[1]; $b = $all[2]; }
	  elsif($all[1] =~ /\//) { ($a, $b) = split(/\//, $all[1]); }
	  else { $a = $all[1]; $b = ""; }
	  $ACTION="X-lated \"$a\" to \"$b\" in variable \"$arg\".";
	  $MAILENV{$arg} =~ tr/$a/$b/;
	} elsif( $command eq "xmessage" ) {
	  $val = join(" ", @all);
	  $ACTION="Passed message to program \"$arg $val\" and replaced it.";
	  &get_message("$real_arg $val");
  	} elsif( $command eq "zap" ) {
	  $ACTION = "Set \"$arg\" to non-permanent.";
	  delete $PRMNT{$arg} if ! $DONT;
	} elsif( ! $command ) {
	  $ACTION = "";  # an extra semi-colon.  Who cares?
	} elsif ( $command eq "if" ) {
	  $ACTION = "Possible error in rule-file.  \"If\" command ignored.";
	} else {
	  $ACTION = "Unrecognized command: \"$command\".";
	}
 	$indent = $SUBBING + $READING; $indent = " " x $indent;
	$LOG = sprintf("  %s(Line %d): $ACTION", $indent, $rulenum+1);
	&log( $LOG ) if $ACTION;
 	if( $DIE ) { return; }
    }
    if($SUBBING) { $SUBBING--; &log(sprintf("  %s(done)"), " " x $SUBBING); }
}

sub check_dnsbl {
  local($dnsbl) = @_;
  local($recd) = $MAILENV{'received'};
  local($rblhost,$chkhost,@check_hosts) = ();
  while($recd =~ s/\[([0-9\.]+)\]//) { push(@check_hosts,$1); }
  foreach $rblhost (split(/,/,$dnsbl)) {
    foreach $chkhost (@check_hosts) { 
      return 1 if &check_rbl($rblhost,$chkhost);
    }
  }
  return 0;
}

sub check_rbl {
  my($rbl,$ip) = @_; return if !($rbl && $ip);
  if($ip=~/[^0-9\.]/) { $ip = join(".",unpack('C4',+(gethostbyname($ip))[4])); }
  return gethostbyname(join(".",(reverse split(/\./,$ip)),$rbl)) ? 1 : 0;
}

sub log {
   local($logging) = @_;
   if( $MODE{'quiet'} ) { return; }
   $lgf = sprintf(">>%s", &real_file($MAILENV{'log_file'}));
   if( $logging =~ /\n$/ ) { chop $logging; }
   if(&zopen(LOGFILE, $lgf)) {
     print LOGFILE "$logging\n";
     &zclose(LOGFILE);
   }
   if( $MODE{'log_out'} ) {
	$outfile = sprintf(">%s", $MODE{'out_to'} ? $MODE{'out_to'} : "-" );
	if(&zopen( FH_LOG, $outfile )) {
	  print FH_LOG "$logging\n";
	  &zclose( FH_LOG );
	}
   }
}

sub post {
   local($groups) = @_;
   local(@filler) = ("and","or","to","from","if","about","re:","the",
		     "in","on","at","above","below","his","her","their",
		     "our","by","because","I","have","do","you","me");
   &keep_header("subject","summary","keywords");

   if(!$MAILENV{'subject'}) { 
     &add_header("Subject: ZFilter $version post.\n");
   }
   if(!$MAILENV{'keywords'}) {
     local($summary) = &remove($MAILENV{'subject'}, @filler);
     &add_header("Keywords: $summary\n");
   }
   if(!$MAILENV{'summary'}) { 
     &add_header("Summary: \n");
   }
   &add_header("Newsgroups: $groups\n");
   if(&zopen( DUMP, "| $news_prog -h" )) {
     print DUMP join("", @ORG_MSG);
     &zclose( DUMP );
   }
}

sub reset_sum {
   local($log_dir);
   if( &real_file($MAILENV{'log_file'}) =~ /(.+\/).*/ ) { $log_dir = $1; }
   print "Resetting Summaries...";
   &zap_file("$log_dir$act_summary"); &zap_file("$log_dir$mail_summary");
   print "Done.\n";
}

sub reset_all {
   local($lgf) = $lgf = sprintf(">%s", &real_file($MAILENV{'log_file'}));
   &reset_sum; 
   print "Resetting Logs and permanent variables...";
   &zap_file(&real_file($MAILENV{'log_file'})); &zap_file($prmnt_file);
   print "Done.\n";
}

sub quote_var {
   local($var) = @_;
   local(@lines) = split(/\n/,$MAILENV{$var});
   local($line);
   foreach $line (@lines) {
     $line = sprintf("> %s",$line);
   }
   $MAILENV{$var} = join("",@lines);
}

sub run_later {
   local($time_to_run, $command) = @_;
   local($pid);
   
   if( $pid = fork) { return; }
   elsif( defined $pid ) {
        $0 = "ZFilter Command Daemon";
        if ( $time_to_run < time ) { sleep (time - $time_to_run); }
        &take_action($command);
        exit 0;
   } else {
        &log("Can't fork!");
   }
}

sub clear_log {
   local($logging) = @_;
   local($log_dir,$act,$logline);
   if( &real_file($MAILENV{'log_file'}) =~ /(.+\/).*/ ) { $log_dir = $1; }
   
   print "Reading log file...";
   if(&lock("${log_dir}$act_summary") || &lock("${log_dir}$mail_summary")) {
	print "Summary files are in use.  Try again later.\n";
	return;
   }
   if(&zopen(LOGFILE, &real_file($MAILENV{'log_file'}))) {
     dbmopen(%LOGSUM, "${log_dir}$act_summary",0600);
     dbmopen(%LOGMSM, "${log_dir}$mail_summary",0600);
     print "\nSummarizing.";
     while(<LOGFILE>) {
	$logline = $_;
	if( $logline =~ /^\s+\(Line \d+\): (.+)$/ ) {
	   $act = $1; $act =~ s/(Sent .+) to .+$/$1/; 
	   $act =~ s/\S+ (to list \S+)$/$1/;
	   $act =~ s/\S+ (from list \S+)$/$1/;
           $act =~ s/\s+\"\s*$/"/;
	   $LOGSUM{$act}++ if (  !( $act =~ /^Stopped processing/ ) && !( $act =~ /^Possible error/) );
	   print ".";
	} elsif ( $logline =~ /^Mail from (\S*) /i ) {
	   $act = $1; $LOGMSM{$act}++;
	   print "o";
	}
     }
     dbmclose(%LOGSUM); dbmclose(%LOGMSM); &zclose(LOGFILE);
     &unlock("${log_dir}$mail_summary"); &unlock("${log_dir}$mail_summary");
     print "\nClearing...";
     &zap_file(&real_file($MAILENV{'log_file'}));
     print "Done.\n";
   } else {
     print "\nCan't open log file.  A file lock exists.\n"; 
   }
}

# Abbreviated mail_canned; mails the output of a program to specified user
sub mail_result {
   local($to) = @_;
   &mail($to,$MAILENV{'mail_subj'},$MAILENV{'result'}); 
}

# sends a canned reply to sender (accepts the file to send)
sub mail_canned { 
   local($canned_resp, $to) = @_;
   local($form, $lvar, $rep, $n, $act, $temp);
   if(&zopen( FH_FORM, $canned_resp )) {
     local(@FORM_RESP) = <FH_FORM>;
     &zclose(FH_FORM);
     foreach $form (@FORM_RESP) {
       while( $form =~ /\{([^\}\s]*)\}/ ) {
	$lvar = $1; $rep = $MAILENV{$lvar};
	if( !$MAILENV{$lvar} && ($lvar =~ /[\#\,]$/) ) {
	   $n = $MAILENV{$lvar}; $temp = $lvar; $act = "";
	   # Try and figure out where the variable ends and the options
           # begin.  :)
	   while( (! $n) && ($temp) ) {
	     $temp =~ s/(\S)$//; $act = "$act$1"; $n = $MAILENV{$temp};
	   }
	   if( $act =~ /\,/ ) {
	     while ($n =~ /\d{4}/ ) {
                $n =~ s/(\d+)(\d{3})/$1,$2/;
	     }
	     $rep = $n;
	   }
	   if( $act =~ /#/ ) {
	     if( $n =~ /1$/ ) { $rep = "${n}st"; }
	     elsif( $n =~ /2$/ ) { $rep = "${n}nd"; }
	     elsif( $n =~ /3$/ ) { $rep = "${n}rd"; }
	     elsif( $n =~ /[4567890]$/ ) { $rep = "${n}th"; }
	   }
	}
	$form =~ s/\{$lvar\}/$rep/;
       }
     }
     &mail($to,$MAILENV{'mail_subj'},@FORM_RESP); 
   }
}
   
# pipes the mail message through next program.
sub run_through {
   local($prog, @stuff) = @_;
   local(@TMP);
   $prog = sprintf("| %s > %s", $prog, $temp_file);
   if(&zopen( PIPETHRU, $prog)) {
     print PIPETHRU join("",@stuff);
     &zclose( PIPETHRU );
     &zopen( TEMP, $temp_file );
     @TMP = <TEMP>;
     &zclose(TEMP); unlink($temp_file);
     $MAILENV{'result'} = join("", @TMP);
   }
}

# just runs the next program... (yes I know this is redundant)
sub run_to {
   local($prog) = @_;
   local(@TMP);
   $prog = sprintf("%s |", $prog, $temp_file);
   if(&zopen( FH_PIPE, $prog)) {
     @TMP = <FH_PIPE>;
     &zclose(FH_PIPE); unlink($temp_file);
     $MAILENV{'result'} = join("", @TMP);
   }
}

# Sends the message to everyone on the list
sub send_to_list {
  local($list) = @_;
  local($key); 
  &set_header("Precedence","Bulk"); &set_header("Sender",$MAILENV{'to'});
  if( dbmopen( %LIST, "$list_dir/$list", undef ) ) {
	foreach $key (sort keys %LIST) {
	  if( $key ne  $MAILENV{'real_sender'} ) {
	     &mail($key, $MAILENV{'list_mail_subj'}, @ORG_MSG);
	  }
	}
        dbmclose( %LIST );
  }
}

# accepts the folder to save the mail to.
sub save_to {
    local($file) = @_;
    $file = &real_file($file);
    if( $file eq &real_file($MAILENV{'inbox'}) ) {
	&remove_header("status");
    }
    local($temp) = sprintf(">>%s", $file);
    if( &zopen( OUTFILE, $temp ) ) {
       print OUTFILE join("",@ORG_MSG);
       print OUTFILE "\n\n";  # for mail filtering programs.
       &zclose( OUTFILE ); chmod( $PMODE, $file ); 
    } elsif( $file eq &real_file($MAILENV{'inbox'}) ) {
       warn "Error saving to inbox!\n";
       &dead_letter || &send_panic_email;
    } else { $save_at_end = 1; }
}

# returns 1 if the content of the current message is unique in the folder
sub unique {
    local($file) = @_;
    local($retval) = 1;
    if(! $MAILENV{'content'}) { return 1; }
    if( &zopen( FH_FOLDER, $file ) ) {
	local($TEMP) = join("", <FH_FOLDER>);
	&zclose(FH_FOLDER);
	if( index($TEMP, $MAILENV{'content'}) >= 0 ) { $retval = 0; }
    }
    return $retval;
}

# returns 1 if the content of the message has anything but whitespace
sub empty {
    if( $MAILENV{'content'} =~ /\S/ ) { return 1; } else { return 0; }
}

# Pipe header through prog, get new header.
sub get_header {
   local($prog) = @_; local(@TMP);
   $prog = sprintf("| %s > %s", $prog, $temp_file);
   if(&zopen( PIPETHRU, $prog)) {
     print PIPETHRU $MAILENV{'header'};
     &zclose( PIPETHRU );
     &zopen( TEMP, $temp_file );
     @TMP = <TEMP>;
     &zclose(TEMP); unlink($temp_file); 
     $MAILENV{'header'} = join("", @TMP);
     &remake_msg; 
   }
}

# Pipe content through prog, get new content.
sub get_content {
   local($prog) = @_; local(@TMP);
   $prog = sprintf("| %s > %s", $prog, $temp_file);
   if(&zopen( PIPETHRU, $prog)) {
     print PIPETHRU $MAILENV{'content'};
     &zclose( PIPETHRU );
     &zopen( TEMP, $temp_file );
     @TMP = <TEMP>;
     close(TEMP); unlink($temp_file); 
     $MAILENV{'content'} = join("", @TMP);
     &remake_msg;
   }
}

# Pipe message through prog, get new message.
sub get_message {
   local($prog) = @_; local(@TMP);
   $prog = sprintf("| %s > %s", $prog, $temp_file);
   if(&zopen( PIPETHRU, $prog)) {
     print PIPETHRU $MAILENV{'header'}, "\n", $MAILENV{'content'};
     &zclose( PIPETHRU );
     &zopen( TEMP, $temp_file );
     @TMP = <TEMP>;
     &zclose(TEMP); unlink($temp_file);
     @ORG_MSG = join("", @TMP);
   }
}


# This adds a name to the "from" line (or changes it if there is one)
# For mail readers like elm that show the name of the sender if it's
# in "From: whatever@wherever (Sender's Name)" format.
sub set_from {
    local(@val) = @_;
    local($set) = 0;
    local($email, $line, $prev_val, $first, $second);
    local($set_from) = join(" ",@val);
    $set_from =~ s/\s*$//;
    foreach $line (@ORG_MSG) {
	if( !$set && ($line =~ /^From: (.+)$/) ) {
	   $prev_val = $1; 
	   if( $prev_val =~ /^(\S+) ([<(][!>)]+[>)])$/ ) {
		$first = $1; $second = $2;
		if($first =~ /@/) { $email = $first; }
		elsif( $second =~ /@/ ) { $email = $second; }
		else{ $email = ""; } # What the??
	   } elsif( $prev_val =~ /@/ ) { $email = $prev_val; }
	   else { $email = $MAILENV{'real_sender'}; }
	   $line = "From: $email ($set_from)\n";
	}
    }
}

# Adds it's arguments to the message header
sub add_header {
    local(@add_hdr) = @_;
    local(@temp_list);
    local($line, $add);
    foreach $line (@ORG_MSG) {
	if(!$add && ($line =~ /^$/)) {
		push(@temp_list, @add_hdr); $add++;
	}
	push(@temp_list, $line);
    }
    @ORG_MSG = @temp_list;
}

# Removes the line containing the variable given
# from the header of the message.
sub remove_header {
    local(@vars) = @_;
    local(@temp_list);
    local($line, $done, $var, $skip);
    foreach $line (@ORG_MSG) {
	if(!$done) { foreach $var (@vars) {
	   if($line =~ /^$/ ) { $done++; $skip = 0; }
	   elsif($line =~ /^$var:/i ) { $skip = 1; }
	   elsif($line =~ /^\S+:/ ) { $skip = 0; }
	}}
	if(!$skip) { push(@temp_list, $line); }
    }
    @ORG_MSG = @temp_list;
}

# Removes all but the vars given from the message header
sub keep_header {
   local(@vars) = @_;
   local($line, $done, $var, $skip, $flag, $val, $val2);
   $skip = 1;  # default
   foreach $line (@ORG_MSG) {
	if(!$done) {  # Haven't reached end-of-header
	  if( $line =~ /^$/ ) { $done = 1; $skip = 0; }
	  elsif( $line =~ /^([^:]+):/ ) { 
	    $val = $1; $val =~ tr/A-Z/a-z/; 
	    $flag = 0;  # Haven't found our variable in the header 
	    foreach $var (@vars) {
		$val2 = $var; $val2 =~ tr/A-Z/a-z/;
		if($val2 eq $val) { $flag = 1; }
	    }
	    if( $flag ) { $skip = 0; } else { $skip = 1; }
	  }
	}
	if(!$skip) { push(@temp_list, $line); }
    }
    @ORG_MSG = @temp_list;
}
	     
# Just a combo of add & remove header for convenience
# Sets ONE variable
sub set_header {
    local($var, $val) = @_;
    local($temp) = $var; $temp =~ tr/A-Z/a-z/;
    if($MAILENV{$temp}) { &remove_header($var); }
    &add_header("$var: $val\n");
}

# Duhh...
sub version {
    print "ZFilter version $version released $released.\n";
}

# Adds person to a list
sub add_list {
  local($list, $address) = @_;
  $address =~ tr/A-Z/a-z/;
  if( ! -d $list_dir && &make_dir($list_dir)) {
	print "Can't make list folder "; return;
  }
  dbmopen(%LIST, "$list_dir/$list.lst",$PMODE) || return;
  $LIST{$address} = 1;
  dbmclose(%LIST);
  print "Added \"$address\" to list \"$list\".\n";
}

# Removes someone from a list
sub del_list {
  local($list, $address) = @_;
  local($temp); $address =~ tr/A-Z/a-z/;
  dbmopen(%LIST, "$list_dir/$list.lst",undef) || return;
  delete $LIST{$address};
  dbmclose(%LIST);
  print "Removed \"$address\" from list \"$list\".\n";
}

# Prints out a list
sub print_list {
  local($list) = @_;
  local($key); 
  dbmopen(%LIST, "$list_dir/$list.lst",undef) || return;
  print "Listing addresses in list \"$list\":\n";
  foreach $key (sort keys %LIST) {
	print "$key\n";
  }
  dbmclose(%LIST);
}

# Searches lists for a person, prints out lists that have them on it
sub what_lists { 
  local($address) = @_;
  local($key); $address =~ tr/A-Z/a-z/;
  print "Checking lists for \"$address\"...\n";
  &check_what_lists( $address );
  foreach $key (sort keys %MAILENV) {
	if( $key =~ /^list\.(.+)$/ ) { print "on list \"$1\"\n"; }
  }
}

# Try to page the user if s/he/it is on.
sub page {
  local($msg) = @_;
  if( open(UTMP, "/var/run/utmp") ) {
    local($utmp) = <UTMP>; close(UTMP);
    local($i, $port, $user);
    while($i < length($utmp))  {
      $port = substr($utmp, $i+0,  8); $port =~ s/[\s\0]+//g;
      $user = substr($utmp, $i+8, 16); $user =~ s/[\s\0]+//g;
      if($user eq $uname) {
        open(PING, ">> /dev/$port");
        print PING "\a$msg\n";
        close(PING);
      }
      $i += 60;
    }
  }
}


# Displays usage
sub usage {
  print<<"END"; 
Usage: zfilter [command-line options]

Command-line options are:
   -C  : Engage Config Mode
   -c  : Clear & Summarize Logs
   -I  : Ignore next argument
   -s  : Display filter activity summary
   -S  : Display filter logs
   -r  : Display rules file
   -u  : Display command-line options
   -V  : Display ZFilter Version number & Release date
   -x  : Reset summaries
   -X  : Reset everything

General usage for .forward files and processing saved messages:
Usage: | zfilter [extra options]

Other options (available when parsing a message):
   -i  : Ignore reply-to field when sending canned replies
   -l  : Log actions only (don't log sender and subject)
   -n  : Not really (take no actions, only display log)
   -q  : Quiet (don't log anything)
   -v  : Log-Out (to stdio or redirected by "-o")
   -U user : Try to run as the user given.  (Only works for root.)
   -f filename : Use \"filename\" as the rules file
   -F filename : Use \"filename\" as the defaults file
   -o filename : Also echo logs to \"filename\" (or device)  
   -p filename : Use \"filename\" for permanent data
   -t filename : Use \"filename\" as temporary space

Additionally, the following commands are used to manage lists:
   -A list address : Adds \"address\" to the list \"list\"
   -D list address : Removes \"address\" from the list \"list\"
   -P list         : Prints all the people on list \"list\"
   -W address      : Prints all the lists the person is on
   -L path         : Use \"path\" to store list information

Additional information about command-line and other options
can be found in the ZFilter README file (normally called
"README.zfilter" in the same distribution packet as this
program.

Using ANY of the command-line options (not the extras) will
cause ZFilter to exit without actually processing a message.
Putting the command-line options in a .forward file is self-
defeating.
END
}

sub sig_handler {
  local($sig) = @_;
  warn "SIG$sig detected...\n";
  if($sig eq "ALRM") { $SIGALRM_SET = 1; return; }
  foreach $handle (sort keys %HANDLES) { &zclose($handle); } 
  if($sig eq "ABRT") { die "Received SIGABRT.  Exiting... "; }
  else {
     &dead_letter || die "Can't dump letter. Exiting... ";
  }
  exit;
} 

##############################################################
# Utility subs (stuff that generates data for purely internal use)
##############################################################

sub pr {
    local($file) = @_;
    $outfile = $MODE{'out_to'} ? sprintf(">%s", $MODE{'out_to'}) : ">-";
    if(&zopen( FH_PRNT_I, $file ) && &zopen(FH_PRNT_O, $outfile)) {
      print FH_PRNT_O join("",<FH_PRNT_I>);
      &zclose(FH_PRNT_I,FH_PRNT_O);
    } else { 
      print "Can't open files for reading."; 
    }
}

# Delete a file
sub zap_file {
    local($file) = @_;
    if( &zopen(FILE, ">$file") ) { &zclose(FILE); }
}

sub reset_user {
  local($user) = @_;
  local($x);
  if( $user =~ /^\d+$/ ) { 
     ($uname, $x, $x, $x, $x, $x, $x, $udir, $x) = getpwuid($user);
  } else {
     ($uname, $x, $x, $x, $x ,$x, $x, $udir, $x) = getpwnam($user);
  }
  $defaults_file = sprintf("%s/.zfdefaults", $udir);
  $prmnt_file    = sprintf("%s/.zfprmnt", $udir);
  $temp_file     = sprintf("%s/.zftemp.%d", $udir, $$);
  $list_dir      = sprintf("lists", $udir);
  $MAILENV{'inbox'} = sprintf("/var/mail/%s",$uname);
  $MAILENV{'base_dir'} = sprintf("%s/", $udir);
}

# Lock a file
sub lock {
   local($file) = @_;
   local($attempts, $flock) = ($LOCK_ATTEMPTS, "$file.lock");
   local($mayday) = $LOCK_ATTEMPTS * $LOCK_INTERVAL * 2;
   if($SIGALRM_SET) { $SIGALRM_SET = 0; }
   alarm $mayday;
   while(!$SIGALRM_SET && $attempts && -e $flock) { 
       $attempts--; sleep $LOCK_INTERVAL; 
   }
   if($SIGALRM_SET) { 
	push(@ERRORS, "Can't lock file [$file], received SIGALRM.\n"); 
        $SIGALRM_SET = 0; return 1; 
   }
   if($attempts) { open(LOCKFILE, ">$flock"); close(LOCKFILE); return 0; } 
   else { 
      push(@ERRORS, "Can't lock file [$file], lock file [$flock] exists.\n");
      return 1; 
   }
}

# Unlock a file
sub unlock {
   local($file) = @_;
   local($flock) = "$file.lock";
   unlink($flock);
}

# Procedure for opening a file...
sub zopen {
   local($handle, $filename) = @_;
   local($need_flock, $file) = 0;

   if($filename =~ /^\s*\>+(.+)/) { 
     $file = $1; $need_flock = 1; 
   } elsif($filename =~ /^\s*\|\s*\S+\s*\>(.+)/) {
     $file = $1; $need_flock = 1;
   }

   if($need_flock && &lock($file)) {
     &log("Error opening file \"$filename\" - file lock \"$filename.lock\".");
     return 0;
   }

   if(!open($handle, $filename)) {
     push(@ERRORS,"Couldn't open [$filename].\n"); return 0;
   }
   if($need_flock) { $HANDLES{$handle} = $file; }
  
   # Added security.  Theoretically, this should fend off other programs.
   # Do NOT use No-Block.  If we close the file now, we lose it!
   if($need_flock && $USE_FLOCK) { flock($handle, $LOCK_EX); }
   return 1;
}

# Proc for closing a file...
sub zclose {
   local(@closes) = @_;
   foreach $handle (@closes) {
	if($HANDLES{$handle}) {
	   &unlock($HANDLES{$handle});
	   if($USE_FLOCK) { flock($handle, $LOCK_UN); }
	   delete $HANDLES{$handle};
	}
	close($handle);
   }
}

# Resolves a hostname, returns the IP address
sub resolve_host {
  local($hostname) = @_;
  if($hostname =~ /!/) { return "UUCP"; }
  if($hostname =~ /^(.+)@(.+)$/) { $hostname = $2; }
  local(@hostdata) = gethostbyname($hostname);
  if($hostdata[4]) {
    return sprintf("%d.%d.%d.%d",unpack('C4', $hostdata[4]));
  } else {
    return;
  }
}
   
# Mail a @ containing a message to the given "to" w/ the given subject
sub mail {
   local($to,$subj,@MSG) = @_;
   if(&zopen( DUMP, "| $mail_prog $to" )) {
     print DUMP "To: $to\n", "Subject: $subj\n";
     print DUMP "X-Filtered-By: ZFilter $version\n";
     print DUMP join("", @MSG);
     &zclose( DUMP );
   } else {  
     &log("Panic!  Can't open mail program!");
   }
}

# This is stupid. Is "command" on the @no_resp_cmds list?
sub dont_respond {
   local($cmd) = @_;
   local($test);
   foreach $test (@no_resp_cmds) {
	if( $test eq $cmd ) { return 1; }
   }
   return 0;
}

# Return the full pathname
sub real_file {
   local($filename) = @_;
   local($retfile, $x, $dir, $user);
   if( substr($filename, 0, 1) eq "/" ) {
	$retfile = $filename;
   } else {
	if( $filename =~ s/^~([^\/]*)// ) {
	  $user = $1; 
	  if( $user ) { 
	    ($x, $x, $x, $x, $x, $x, $x, $dir, $x) = getpwuid($>);
	  } else { $dir = $udir; }
	  $retfile = sprintf("%s%s",$dir,$filename);
	} else { 
          # $dir = $filename; }
          $retfile = sprintf("%s%s", $MAILENV{'base_dir'}, $filename );
        }
   }
   return $retfile;
}

# Returns a time (seconds since epoch) based on
# a given relative or specified time
sub real_time {
  local($convert) = @_;
  local($ntime, $h,$m,$s) = (time);
  local($nh,$nm,$ns) = +(localtime($ntime))[2,1,0];
  $ntime -= (60*60*$nh + 60*$nm + $ns);   # Ntime is midnight today

  if($convert =~ /(\d*):(\d*):(\d*)/) {   # eg. 12:00:02  hh.mm.ss
    $h = $1; $m = $2; $s = $3;
  } elsif( $convert =~ /(\d*):(\d*)/) {   # eg. 12:00     hh.mm
    $h = $1; $m = $2; $s = 0;
  } elsif( $convert =~ /(\d+)/)       {   # eg. 12        ss
    $h = 0; $m = 0; $s = $1;
  }
  if($convert =~ /^\+(.*)/) {
    $h += $nh; $m += $nm; $s += $ns;
  } 
  return $ntime + 60*60*$h + 60*$m + $s;
}

# Second Generation Parser :)
# Operators: ! (not), =, !=, >, <, <=, >=, # (regexp pattern search),
# and ? (regexp case-insensitive pattern search)
sub true_expr {
  local($expression) = @_;
  local($subX,$eval,$temp,$neg,$var,$work,$val1,$val2,$rel,@args,@ops);
  local(@fin_eval);
  local($ret) = 1;
  #chop off surrounding parens if necessary
  $expression =~ s/^\(//;
  $expression =~ s/\)$//;
  
  #parse out subs
  while( $expression =~ /\(([^()]*)\)/ ) {
	$subX = $1;
	$eval = &true_expr( $subX );
	$subX = "\\($subX\\)";
        $subX =~ s/([|])/\\|/g;
	$expression =~ s/$subX/$eval/;
  }
 
  #should be a nice, spiffy, un-paren'd expression now
  #Strip unnecessary spacing, double &s and |s, sort
  $temp = $expression;
  #$temp =~ s/ //g;
  $temp =~ s/ ?&+ ?/&/g;
  $temp =~ s/ ?\|+ ?/|/g;
  @args = split(/[|&]+/, $temp); 
  $temp =~ s/[^|&]//g;
  @ops = split(//, $temp);

  #Munch.  Munch.  Test all the args and replace with "1" or "0".  :)
  #Simplistic, and redundant for "$arg1 & $arg2" with $arg1  false
  #So sue me.
  while( $#args >= 0 ) {
	$work = shift( @args );
	if( $work =~ /^\s*(!?)\s*([^<>!?#= ]+)\s*([!<>?#=]+)\s*(.+)\s*$/ ) {
	   $neg = $1; $val1 = $2; $rel = $3; $val2 = $4;
  	   if( $val2 =~ /^\s*\"(.*)\s*\"\s*$/ ) {
		$temp = $1;
		$var = &str_eval($MAILENV{$val1}, $rel, $temp);
	   } elsif ( $val2 =~ /^\s*(\d+)\s*$/ ) {
		$var = &num_eval($MAILENV{$val1}, $rel, $MAILENV{$val2});
	   } else {
		if(($rel eq "#" || $rel eq "?") || 
                   $MAILENV{$val2} =~ /\D/) {
                   $var = &str_eval($MAILENV{$val1},$rel,$MAILENV{$val2});
		} else {
		   $var = &num_eval($MAILENV{$val1},$rel,$MAILENV{$val2});
		}
	   }
	   $var = ($neg) ? (!$var) : $var;
  	} elsif( $work =~ /^\s*(!?)\s*(\S+)\s*$/ ) {
	   $neg = $1; $val1 = $2;
	   if( $val1 =~ /^\s*always\s*$/i ) { 
		$var = 1; 
	   } elsif( $val1 =~ /^\s*never\s*$/i ) { 
		$var = 0; 
	   } elsif( $val1 =~ /\s*\"(.*)\"\s*/ ) {
		if( length($1) && $1 ne "0" ) { $var = 1; }
		else { $var = 0; }
	   } elsif ( $val1 =~ /^\s*(\d+)\s*$/ ) {
		if( $1 != 0 ) { $var = 1; }
		else { $var = 0; }
	   } elsif ( $val1 =~ /^\s*(\S+)\s*$/ ) {
		$temp = $1;
		if( $MAILENV{$temp} ) { $var = 1; }
		else { $var = 0; }
	   }
	   $var = ($neg) ? !$var : $var;
	}
	push(@fin_eval, $var);
	if( $#ops >= 0 ) { push(@fin_eval, shift(@ops)); }
  }
  local($stop) = -1;
 
  #boy oh boy oh boy!  Take our 1s and 0s and Ops and figure things out.
  while( $stop < 0 && $#fin_eval > 0 ) {
	if($#fin_eval > 1) {
		$val1 = shift(@fin_eval);
		$rel = shift(@fin_eval); $val2 = shift(@fin_eval);
		if( $rel eq "&" && ($val1 && $val2) ) { 
			unshift(@fin_eval, "1");
		} elsif ($rel eq "|" && ($val1 || $val2) ) {
			unshift(@fin_eval, "1");
		} else { unshift(@fin_eval, "0"); }
	} else {
		$stop = "Not Good.";
	}
  }
  $ret = shift(@fin_eval);
}

sub str_eval {
  local($var1, $rel, $var2) = @_;
  local($eval, $ret) = 0;
  if( ($rel eq ">")  && ($var1 gt $var2) ) { $eval = 1; }
  elsif( ($rel eq "<")  && ($var1 lt $var2) ) { $eval = 1; }
  elsif( ($rel eq ">=") && ($var1 ge $var2) ) { $eval = 1; }
  elsif( ($rel eq "<=") && ($var1 le $var2) ) { $eval = 1; }
  elsif( ($rel eq "!=") && ($var1 ne $var2) ) { $eval = 1; }
  elsif( ($rel eq "=")  && ($var1 eq $var2) ) { $eval = 1; }
  elsif( ($rel eq "#") && ($var1 =~ /$var2/  ) ) { $eval = 1; }
  elsif( ($rel eq "?") && ($var1 =~ /$var2/i ) ) { $eval = 1; }
  $ret = $eval;
}

sub num_eval {
  local($var1, $rel, $var2) = @_;
  local($eval, $ret) = 0;
  if( ($rel eq ">")  && ($var1 > $var2) ) { $eval = 1; }
  elsif( ($rel eq "<")  && ($var1 < $var2) ) { $eval = 1; }
  elsif( ($rel eq ">=") && ($var1 >= $var2) ) { $eval = 1; }
  elsif( ($rel eq "<=") && ($var1 <= $var2) ) { $eval = 1; }
  elsif( ($rel eq "!=") && ($var1 != $var2) ) { $eval = 1; }
  elsif( ($rel eq "=")  && ($var1 = $var2) ) { $eval = 1; }
  $ret = $eval;
}
	
sub respond_ok {
    local($ret) = 1;
    foreach $frm (@no_resp_from) {
	if( $MAILENV{'real_sender'} =~ /$frm/i ) { $ret = 0; }
    } 
    foreach $sub (@no_resp_subj) {
	if( $MAILENV{'subject'} =~ /$sub/i ) { $ret = 0; }
    }
    if( $MAILENV{'x-filtered-by'} ) { $ret = 0; }
    return $ret;
}

# Remove word(s) from the literal
sub remove {
   local($literal, @words) = @_;
   local($word);
   foreach $word (@words) {
	$literal =~ s/\s*$word\s*/ /ig;
   }
   return $literal;
}

# Rebuilds ORG_MSG from header and content
sub remake_msg {
   @ORG_MSG = ($MAILENV{'header'}, "\n", $MAILENV{'content'});
}

# Resync message header with variables
sub resync_vars {
   local($temp);
   while($temp = shift(@MSG_KEYS)) {
	delete $MAILENV{$temp};
   }
   &parse_msg; &do_extras;
}
sub parse_mode {
# Parse args (if any)
  local($ON, $exit, $return) = (1,0,0); 
  local(@TMP, $at);
  while( ($arg = shift(@ARGV) ) ) {
    
    # If multiple args were given with one leading "-"...
    if( $arg =~ /^-[\w][\w]/ ) {
      @TMP = split(//, $arg);
      foreach $at (@TMP) { $at = "-$at"; push(@ARGV, $at); } 
    }

    elsif( $arg eq "--" ) { } # shut up about it. 
    elsif( $arg eq "-C" ) { $MODE{'config'} = $ON; $exit = 1; }
    elsif( $arg eq "-c" ) { $MODE{'clear_log'} = $ON; $exit = 1; }
    elsif( $arg eq "-i" ) { $MODE{'ignore_reply_to'} = $ON; }
    elsif( $arg eq "-I" ) { shift(@ARGV); }
    elsif( $arg eq "-f" ) { $MAILENV{'rules_file'} = shift(@ARGV); }
    elsif( $arg eq "-F" ) { $defaults_file = shift(@ARGV); }
    elsif( $arg eq "-l" ) { $MODE{'actions_only'} = $ON; }
    elsif( $arg eq "-n" ) { $MODE{'no_action'} = $ON; $MODE{'log_out'} = $ON; }
    elsif( $arg eq "-p" ) { $prmnt_file = shift(@ARGV); }
    elsif( $arg eq "-q" ) { $MODE{'quiet'} = $ON; }
    elsif( $arg eq "-s" ) { $MODE{'summary'} = $ON; $exit = 1; }
    elsif( $arg eq "-S" ) { $MODE{'viewlog'} = $ON; $exit = 1; }
    elsif( $arg eq "-r" ) { $MODE{'viewrules'} = $ON; $exit = 1; }
    elsif( $arg eq "-t" ) { $temp_file = shift(@ARGV); }
    elsif( $arg eq "-u" ) { $MODE{'usage'} = $ON; $exit = 1; }
    elsif( $arg eq "-U" ) { &reset_user(shift(@ARGV)); }
    elsif( $arg eq "-v" ) { $MODE{'log_out'} = $ON; }
    elsif( $arg eq "-V" ) { $MODE{'version'} = $ON; $exit = 1; }
    elsif( $arg eq "-o" ) { $MODE{'out_to'} = shift(@ARGV); }
    elsif( $arg eq "-x" ) { $MODE{'reset_sum'} = $ON; $exit = 1; }
    elsif( $arg eq "-X" ) { $MODE{'reset_all'} = $ON; $exit = 1; }
    elsif( $arg eq "-A" ) 
     { $MODE{'addlist'} = shift(@ARGV); $WHO = shift(@ARGV); $exit = 1; }
    elsif( $arg eq "-D" ) 
     { $MODE{'dellist'} = shift(@ARGV); $WHO = shift(@ARGV); $exit = 1; }
    elsif( $arg eq "-P" ) { $MODE{'prnlist'} = shift(@ARGV); $exit = 1; } 
    elsif( $arg eq "-L" ) { $MAILENV{'list_dir'} = shift(@ARGV); }
    elsif( $arg eq "-W" ) { $MODE{'whatlists'} = shift(@ARGV); $exit = 1; }
    elsif( $arg eq "/?" || $arg eq "-h" || $arg eq "-H" || $arg eq "-?" ) 
			  { $MODE{'usage'} = $ON; $exit = 1; }
    else{print "\"$arg\" is unknown in this version of Zfilter ($version).\n";}
  }
  $return = $exit;
}

sub parse_msg {
  local($temp);
  foreach $line (@ORG_MSG) {
    if( !($MAILENV{'lines'}) && !($line =~ /^$/) ) {
	$MAILENV{'header'} .= $line;
        if( $line =~ /^(\S+): (.*)$/ ) {
	   $var = $1; $val = $2; $var =~ tr/A-Z/a-z/;
	   $MAILENV{$var} .= $val;
	   push( @MSG_KEYS, $var );
        } elsif ( $line =~ /^From (\S+) / ) {
	   $val = $1;
	   $MAILENV{'real_sender'} = $val;
	   push( @MSG_KEYS, "real_sender" );
        } elsif ( $line =~ /^\s+(.*)$/ ) {
	   $val = $1;
	   $MAILENV{$var} .= $val;
	}
    } else {
	$MAILENV{'content'} .= $line if $MAILENV{'lines'}; 
        $temp = $line; $temp =~ s/^\s*//; $temp =~ s/\s*$//g;
        $MAILENV{'lines'}++;
        $MAILENV{'chars'} += length($line);
        $MAILENV{'words'} += $#+(split(/\s+/,$temp));
    }
  }
  $MAILENV{'size'} = $MAILENV{'chars'} / 1024;
  if( $MAILENV{'chars'} % 1024 ) { $MAILENV{'size'}++; }
  @chain_check = grep(/forwarded message|forwarded mail|fwd/i, @ORG_MSG);
  if($#chain_check > $MAILENV{'chain_threshold'}) { 
        $MAILENV{'chain'} = "TRUE";
  }
}

sub load_defaults {
  if ( &zopen( DEFAULTS, $defaults_file ) ) {
     while( <DEFAULTS> ) {
        if ( /^(\S*)\s*=?\s*(.*)\s*$/ ) {
           $key = $1; $val = $2; $key =~ tr/A-Z/a-z/;
           $MAILENV{$key} = $val;
        }
     }
     &zclose( DEFAULTS ); 
  }
  $list_dir = &real_file($MAILENV{'list_dir'}); 
  delete $MAILENV{'list_dir'};

  $mail_prog = &real_file($MAILENV{'mail_prog'}); 
  $news_prog = &real_file($MAILENV{'news_prog'});
  if( substr($MAILENV{'base_dir'},0,1) eq "~" ) {
    $MAILENV{'base_dir'} = &real_file($MAILENV{'base_dir'});
  }
  delete $MAILENV{'mail_prog'}; delete $MAILENV{'news_prog'};
  if($MAILENV{'no_flock'}) { $USE_FLOCK = 0; delete $MAILENV{'no_flock'}; }
}

sub load_permanents {
  @now = ("sec","min","hour","day","mon","year");
  if ( &zopen( PRMNT, $prmnt_file ) ) {
   while( <PRMNT> ) {
    if ( /^(\S*)\s*=?\s*(.*)\s*$/ ) {
      $key = $1; $val = $2; $key =~ tr/A-Z/a-z/;
      $PRMNT{$key} = $val;
    }
   } 
   &zclose(PRMNT);
   @ntime = localtime(time);
   @ltime = split(/\s+/, $PRMNT{'last'});
   foreach $var (0 ... $#now) {
     if($ntime[$var] != $ltime[$var]) { $PRMNT{$now[$var]} = 1 } 
     else { $PRMNT{$now[$var]}++; }
   }
   $PRMNT{'last'} = join(" ", @ntime);
   foreach $key (keys %PRMNT) { $MAILENV{$key} = $PRMNT{$key} }
  }
}

sub save_permanents {
   $prm = sprintf(">%s",$prmnt_file);
   if( &zopen( FH_PRMNTS, $prm ) ) { 
     foreach $key (sort(keys %PRMNT)) {
       $key =~ tr/A-Z/a-z/; 
       if( ($MAILENV{$key}) && $MAILENV{$key} != $PRMNT{$key}) {
		$PRMNT{$key} = $MAILENV{$key};
       }
       printf FH_PRMNTS "%s = %s\n", $key, $PRMNT{$key} if $PRMNT{$key};
     }
     &zclose( FH_PRMNTS );
   }
}

sub do_extras {
  push(@MSG_KEYS, "reply-to","sender","email","name","date","time","when");

  # *sigh*
  if ( $MAILENV{'reply-to'} && !($MODE{'ignore_reply_to'})) {
     $MAILENV{'real_sender'} = $MAILENV{'reply-to'};
  }

  # convenience
  if ( ! $MAILENV{'sender'} ) { $MAILENV{'sender'} = $MAILENV{'real_sender'}; }

  if ( ! ( $MAILENV{'real_sender'} =~ /@/ ) ) { $MAILENV{'real_sender'} .= $MAILENV{'local_host'}; }

  # Get name & e-mail preferred addresses from "from":
  if ( $MAILENV{'from'} =~ /(.*)\s*[\(<]([^\)>]*)[\)>]/ ) {
    $f1 = $1; $f2 = $2;
    if( $f1 =~ /@/ ) { $MAILENV{'email'} = $f1; $MAILENV{'name'} = $f2; }
    elsif( $f2 =~ /@/ ) { $MAILENV{'email'} = $f2; $MAILENV{'name'} = $f1; }
  } else {
    $MAILENV{'email'} = $MAILENV{'real_sender'};
    $MAILENV{'name'}  = $MAILENV{'from'};
  }
  $MAILENV{'email'} =~ s/\s+$//; $MAILENV{'name'} =~ s/\s+$//;

  if((! ($MAILENV{'real_sender'} =~ /@/)) && 
      ($MAILENV{'received'} =~ /localhost/i )) { $MAILENV{'ip'} = "LOCAL"; }
  else { $MAILENV{'ip'} = &resolve_host($MAILENV{'real_sender'}); }

  # Get date & time message was sent from "date";
  $MAILENV{'when'} = $MAILENV{'date'};
  if( $MAILENV{'when'} =~ /(.*) (\d+:\d+:\d+) .*/ ) {
     $MAILENV{'date'} = $1; 
     $MAILENV{'time'} = $2;
  } else { 
     $MAILENV{'time'} = $MAILENV{'date'}; 
  }
  
  # Now play with the message.

  # Help prevent mail loops.  This also works to fend off the old filter.
  &set_header("X-Filtered-By","ZFilter $version");  
  # Remove status line (just in case this is a saved file)
  if($MAILENV{'status'}) { &remove_header("status"); }
  # And add our own status line (removed if saving to inbox)
  &set_header("Status","O");
  if( &unique($MAILENV{'inbox'}) ) { $MAILENV{'unique'} = 1; }
  else { $MAILENV{'unique'} = 0; }
  if( &empty ) { $MAILENV{'empty'} = 1; } 
  else { $MAILENV{'empty'} = 0; }
}

# Sets MAILENV variables "list.listname" for each list the person is on
# eg, if someone is on the list "boating" it will set "list.boating"
sub check_what_lists {
  local($address) = @_;
  $address =~ tr/A-Z/a-z/;
  local($file_temp, $temp, $list);
  if( opendir(LISTDIR, $list_dir) ) {
    while($file_temp = readdir(LISTDIR)) {
	if( $file_temp =~ /^(.+).lst.db$/ ) {
 	    $list = $1; 
	    if(dbmopen(%LIST,"$list_dir/$list.lst",undef) && $LIST{$address}) {
	      $temp = "list.$list"; $MAILENV{$temp} = 1; dbmclose(%LIST); 
            }
	}
    } 
  }
}

sub postmaster_add {
  local($address) = @_;
  local($ad, $bangsite);
	
  if( $address =~ /^([^!@]+)@(.+)$/ ) {
     return "postmaster\@$2";
  } elsif( $address =~ /^(.+)!(.+)$/ ) {
     $bangsite = $1; $ad = $2;
     if($ad =~ /^([^@]+)@(.+)$/) {
	return "$bangsite!postmaster\@$2";
     } else {
	return "$bangsite!postmaster";
     }
  }
}
	
sub dead_letter {
   local($panic) = sprintf(">>%s/dead_letter.$$",$udir);
   if( $#ORG_MSG < 0 ) { return 0; }
   if( open(PANIC,$panic) ) {
      print PANIC @ORG_MSG,"\n\n\n";
      close(PANIC);
      return 0;
   } else {
      push(@ERRORS, 
      "Can't save dead letter to [dead_letter.$$] in user's home directory.\n");
      return 1;
   }
}

sub test_flock {
   local($pid);
   if( $pid = fork) {
	if( waitpid($pid, 0) >= 0 ) {
	  if($?) { unlink("test.$pid.$pid.$pid.$pid"); }
	  return ($?/256);
	} else { return 1; }
   } elsif( defined $pid ) {
 	$0 = "ZFilter's Child";
	$temp_file = "test.$$.$$.$$.$$"; 
	open(TEST,">$temp_file");
	flock(TEST,0); close(TEST); unlink($temp_file);
	exit 0;
   } else {
	print "Can't fork!"; 
   }
   return 1;
}

sub send_panic_email {
  local(@errmsg);

  # Message to the sender
  if($PANIC_LEVEL > 0) { 
    @errmsg = ("ZFilter couldn't deliver message to this address.\n",
    "Probably a file access error.\n--- Your message follows ---\n",
    @ORG_MSG);
    &mail($MAILENV{'real_sender'},$ERR_MSG_SUBJ,@errmsg);
  }

  # Message to the local postmaster
  if($PANIC_LEVEL > 1) {
    @errmsg = ("There was a problem delivering mail to the user \"$uname\".\n",
    "ZFilter may not have access to save mail to the appopriate mail folder.\n",
    "Internal error log:\n",@ERRORS,"\n",
    "Further information may be obtained from the following log file:\n",
    &real_file($MAILENV{'log_file'}),"\n","\n--- Original Message Follows ---\n"
    ,@ORG_MSG);
    &mail("postmaster",$ERR_MSG_SUBJ,@errmsg);
  }

  # Message to the postmaster at the sending site
  if($PANIC_LEVEL > 2) {
    @errmsg = ("There was a problem delivering mail to this address.\n",
    "Internal error log:\n",@ERRORS,"\n",
    "Message header follows:\n\n",$MAILENV{'header'},"\n\n");
    &mail(&postmaster_add($MAILENV{'real_sender'}),$ERR_MSG_SUBJ,@errmsg);
  }

  # Message to the user 
  if($PANIC_LEVEL > 3) {
    if( ($MAILENV{'subject'} eq $ERR_MSG_SUBJ) && 
        ($MAILENV{'x-filtered-by'} =~ /Zfilter/i) ) {
      @errmsg = $MAILENV{'content'};
      &mail($uname,$ERR_MSG_SUBJ,@errmsg);
    } else {
      @errmsg = (
      "ZFilter couldn't save a message from \"$MAILENV{'real_sender'}\"\n",
      "An error message has already been sent to your postmaster, the \n",
      "postmaster of the sending site, and the original sender.\n",
      "This is the internal error log:\n",@ERRORS,"\n",
      "Further information might be obtained from your log file - \n",
      "  ",&real_file($MAILENV{'log_file'}),"\n",
      "This is the message header from the message that was sent:\n",
      "$MAILENV{'header'}\n\n");
      &mail($uname,$ERR_MSG_SUBJ,@errmsg);
    }
  }
}
  
#########################################################################
# Alternate invocations

sub setup {
  local($zdl, $key, $input, $mail_prog, $news_prog);
  print "\nZFilter setup mode.  Press <ENTER> to accept the default choice.\n";
  print "~name/ paths are fine wherever you are asked to give a path or\n";
  print "program location.\n";
  $defaults_file = sprintf(">%s", $defaults_file);
  foreach $key (sort(keys %MAILENV)) {
     # List_dir is a special case
     if( ($key ne "list_dir") && !($key =~ /prog$/) ) { 
     	print "$key [$MAILENV{$key}] = ";
     	$input = <STDIN>;
     	chop $input;
     	if( $input ) { $MAILENV{$key} = $input; }
     	if( ($key =~ /base_dir/i) && !($MAILENV{$key} =~ /\/$/)) { 
           $MAILENV{$key} .= "/"; 
     	}
     }
  }
  print "Looking for mail and inews...\n";
  $mail_prog = &find_prog("sendmail"); $news_prog = &find_prog("inews");
  if( $mail_prog ) { print "Found \"sendmail\"\n"; }    
  else { print "Unable to locate \"sendmail\"\n"; }
  if( $news_prog ) { print "Found \"inews\"\n"; }
  else { print "Unable to locate \"inews\"\n"; }
  print "(If shown, the defaults are probably right)\n";

  print "Where is \"sendmail\"? [$mail_prog] = "; $input = <STDIN>; chop $input;
  if( !$input ) { $MAILENV{'mail_prog'} = $mail_prog; }  
  else { $MAILENV{'mail_prog'} = "$input"; }
 
  if( !$MAILENV{'mail_prog'} ) { 
    die "ZFilter is useless without \"sendmail\"!  Commited suicide ";
  }

  if($MAILENV{'mail_prog'} =~ /\/$/) { 
	$MAILENV{'mail_prog'} = "$MAILENV{'mail_prog'}sendmail";
  } elsif( !($MAILENV{'mail_prog'} =~ /\/sendmail$/) ) {
	$MAILENV{'mail_prog'} = "$MAILENV{'mail_prog'}/sendmail";
  }

  print "Where is \"inews\"? [$news_prog] = "; $input = <STDIN>; chop $input;
  if( !$input ) { $MAILENV{'news_prog'} = $news_prog; }  
  else { $MAILENV{'news_prog'} = $input; }

  if($MAILENV{'news_prog'} =~ /\/$/) { 
	$MAILENV{'news_prog'} = "$MAILENV{'news_prog'}inews";
  } elsif( !($MAILENV{'news_prog'} =~ /\/inews$/ ) ) {
	$MAILENV{'news_prog'} = "$MAILENV{'news_prog'}/inews";
  }

  print "Looking to see if the flock(2) call is supported on this system...\n";
  $use_flock = 1;
  if( &test_flock ) { 
   print "WARNING:\n";
   print "It doesn't look like your system supports the flock(2) call.\n";
   print "ZFilter uses it in addition to it's own file-locking system to\n";
   print "help prevent other programs from trying to write to the files\n";
   print "ZFilter is currently writing to at the same time.\n";
   print "Since you don't appear to have it, ZFilter won't try to use it\n";
   print "on your system since using it on a system that doesn't support it\n";
   print "causes ZFilter to abort, losing the mail it is working on.\n";
   print "If you're SURE your system supports it, you can override ZFilter's\n";
   print "decision not to use it.  This is NOT recommended.\n";
   print "Override and use flock(2) anyway? [N] = "; $input = <STDIN>;
   if( ! ($input =~ /^y/i) ) { $use_flock = 0; }
  } else { print "It is.\n"; }
  if(! $use_flock) { $MAILENV{'no_flock'} = "YES"; }

  print "Do you plan to use lists? (Y/N) [N] = "; $input = <STDIN>;
  if( $input =~ /^y/i ) {  
	print "Where do you plan to store them? [$list_dir] = "; 
	$input = <STDIN>; chop $input; $input =~ s/\/$//; 
	if( ! $input ) { $input = $list_dir; }
	if( ! -d $input && &make_dir($input) ) {
		print "Sorry, can't create path... better do it yourself!\n";
		print "Re-config to change the path again if you need to.\n";
	}
	$MAILENV{'list_dir'} = $input; 
  } 
  $zdl = &get_path;
  print "Where is ZFilter? [$zdl] ="; $input = <STDIN>;
  chop $input; $input =~ s/\/$//;
  if( ! $input ) { $input = $zdl; }
  if ( -e "$udir/.forward" ) {
	open( FORWARD, "$udir/.forward" ); @FWD = <FORWARD>; close(FORWARD);
	if( ! grep( /$exec_prog/i, @FWD ) ) { 
	  rename( "$udir/.forward", "$udir/forward.old" );
	  print "Existing .forward file renamed to \"forward.old\".\n";
        } 
  }
  print "Processing .forward file...\n";
  open( FORWARD, ">$udir/.forward" ) || 
    warn "WARNING: Can't create the .forward file!\n";
  if( ! ($input =~ /${exec_prog}$/) ) { $input = "${input}$exec_prog"; } 
  print FORWARD "\"| $input -I $udir\"\n";
  close(FORWARD); chmod(0600, "$udir/.forward");
  print "Processing defaults file...\n";
  open( DEFAULTS, $defaults_file ) || die "Can't open defaults file ";
  foreach $key (sort keys %MAILENV) { 
	print DEFAULTS "$key = $MAILENV{$key}\n";
  }
  close(DEFAULTS);
  print "Done setup.  Saving and Exiting.\n\n";
}

# Tries to figure out where the program is being run from.
sub get_path {
   local($exec_path) = $zero; 
   local($ok, $cdir, $path, $cpath, $flag, @usr_path, $high, $high_path); 
   local($pwd) = &find_prog("pwd");
   local(@check_path) = ("/bin","/sbin","/usr/bin","/usr/sbin","$udir",
	"/usr/local/bin","/usr/local/sbin","$udir/filter","$udir/zfilter",
        "/usr/ucb","/usr/lib");
   if(! ($exec_path =~ /^\//) ) {
	$ok = open(PWD, "$pwd |");
	if(!$ok) { $ok = open(PWD, "pwd |"); }
	if($ok) { 
	   $cdir = <PWD>; chop $cdir; close PWD; 
	   $exec_path =~ s/^\.\///; 
	   $exec_path = "$cdir/$exec_path";
	} else {
	   # Ok, PWD doesn't work, let's search the path.
	   if($ENV{'PATH'}) { 
	 	@usr_path = split(/:/, $ENV{'PATH'});
		$flag = 1;
		foreach $path (@usr_path) {
		   foreach $cpath (@check_path) {	
			if( $cpath eq $path ) { $flag = 0; }
		   }
		   if( $flag && !($path =~ /^\.+$/)) { 
			push(@check_path, $path);
		   }
		}
		@usr_path = ();
		foreach $path (@check_path) {
		   if( -x "$path/$exec_prog" ) {
			$flag = `$path/$exec_prog -V`;
			if( $flag =~ / version ([\d.]+) /i ) {
			   $ok = $1; 
			   if($ok > $high) { $high = $ok; $high_path = $path; }
			}
		   }
		}
	   }
	   if( $high_path ) { $exec_path = "$high_path/$exec_prog"; }
	   else { $exec_path = "$default_loc/$exec_prog"; }
	}
   } 
   return $exec_path;
}

sub find_prog {
  local($proggie) = @_;
  local(@path) = ("/bin","/usr/bin","/usr/contrib/bin", "/usr/local/bin", 
		  "/sbin","/usr/sbin", "/usr/local/sbin","/usr/ucb",
                  "/usr/lib", "/usr/contrib/sbin", "/usr/contrib/lib/news");
  local($usrpath) = $ENV{'PATH'};

  # Merge
  local(@splitpath) = split(/:/, $usrpath);
  local($temp, $temp2, $found);
  foreach $temp (@splitpath) {
    if( ! ($temp =~ /^\.+$/) ) {
	$found = 0; 
	foreach $temp2 (@path) {
	  if( $temp2 eq $temp ) { $found = 1; }
	}
	if(!$found) { push(@path, $temp); }
    }
  }

  # Merged.  Now find.
  foreach $temp (@path) {
    if( -x "$temp/$proggie" ) { return "$temp/$proggie"; }
  }
}

# Tries to make the directory specified
sub make_dir {
  local($path) = @_; 
  $path = &real_file($path);
  local(@elements) = split(/\//, $path);
  local($part, $whole, $error);
  foreach $part (@elements) {
      $whole = sprintf("%s/$part", $whole);
      if( !$error && !( -d $whole) && !(mkdir($whole, $MODE))) {
		print "Error making directory - died with $!\n";
		$error = $!;
      }
  }
  return $error;
}
	
sub summary {
  open(LOGFILE, &real_file($MAILENV{'log_file'}));
  local($sep) = "-" x 78;
  local($key,$grand_total);
  if( &real_file($MAILENV{'log_file'}) =~ /(.+\/).*/ ) { $log_dir = $1; }
  print "ZFilter mail log summary:\n\n";

  # Open the dbm files and get the previous summary totals
  if( -r "${log_dir}$act_summary.db" ) {
     dbmopen(%LOGSUM, "${log_dir}$act_summary", 0600);
     %LINES = %LOGSUM;
     dbmclose(%LOGSUM);
  }
  if( -r "${log_dir}$mail_summary.db" ) {
     dbmopen(%LOGMSM, "${log_dir}$mail_summary", 0600);
     %FROM = %LOGMSM;
     dbmclose(%LOGMSM);
  }

  while(<LOGFILE>) {
     if( /^Mail from (\S*) /i ) { $FROM{$1}++; }
     elsif( /^\s*\(Line \d+\):\s*(.*)/ ) { 
	$key = $1; $key =~ s/ to \S+$//g; $key =~ s/\s+\"\s*$/"/;
	$LINES{$key}++ if (! ($key =~ /^Stopped processing.$/) && ! ($key =~ /^Possible error$/i)) ;
     }
  }
  printf "Action statistics... Actions taken frequencies.\n$sep\n";
  printf "Used : Action\n"; 
  foreach $key (keys %LINES) {
	printf("%4d : %-65.65s\n", $LINES{$key}, $key);
  }
  printf "\nMail statistics... Frequency by address.\n$sep\n";
  printf "Mail : From\n";
  foreach $key (sort keys %FROM) {
	printf "%4d : %-72.72s\n", $FROM{$key},$key;
	$grand_total += $FROM{$key};
  }
  &load_permanents;
  printf "\nVolume by recency mail statistics...\n$sep\n";
  printf "Total Messages received and processed: $grand_total\n";
  printf "Messages received this year: $MAILENV{'year'}\n";
  printf "Messages received this month: $MAILENV{'mon'}\n";
  printf "Messages received today: $MAILENV{'day'}\n";
  printf "Messages received this hour: $MAILENV{'hour'}\n";
  printf "Messages received this minute: $MAILENV{'min'}\n";
}
