#! /usr/bin/perl
###############################################################################
#
# $Id: pattern-server,v 1.3 1997/12/15 06:30:08 bcwhite Exp $
#
# chkmail
#
# Check for a pattern in an email message
#
# Written by:     Behan Webster <behanw@pobox.com>
# Serverified by: Brian White <bcwhite@pobox.com>
#

use Getopt::Long;
use IO::Handle;
use IO::Socket;

require "SPAMPERL/Email.pl";
require "SPAMPERL/Spam.pl";
require "SPAMPERL/Util.pl";



sub usage {
	$0 =~ m|^.*?([^/]+)$|;
	print STDERR "Usage: $1 <server-socket>\n";
	exit 1;
}


sub chkmailusage {
	print STDERR "Usage: chkmail [--header <header>] [--body] <pattern_filename> [...]\n";
	print STDERR "  An email message should follow this command.  It will return 0\n";
	print STDERR "  if any of the patterns in the pattern file(s) match the specified\n";
	print STDERR "  headers or body.\n\n";
	die;
}


sub addpatusage {
	print STDERR "Usage: addpat [--header <header>] [--append <file>] <pattern_filename> [...]\n";
	print STDERR "  An email message should be piped into this command.\n";
	print STDERR "  It will list any To|Cc|Bcc address not matched by any pattern.\n\n";
	die;
}


#
# Run AddPat
#
sub addpat {
	local(@ARGV) = @_;

	#
	# Parse options
	#
	my %opt;
	addpatusage if !GetOptions(\%opt, "append=s", "header=s@", "dest=s", "mail=s", "from=s");
	addpatusage if !@ARGV;
	$opt{"header"} = [ "To|Cc|Bcc" ] if !$opt{"header"};

	#
	# Load pattern files
	#
	my @patterns = ();
	readPatternFiles( \@patterns, @ARGV );

	#
	# Read in email from STDIN
	#
	my (%header, $head, $body);
	parseEmail(\%header, \$head, \$body);

	#
	# Find relevant headers/body to search
	#
	my @search = ();
	my $headers = lc "^(Resent-)?(".join("|", @{$opt{"header"}}).")\$";
	foreach (keys %header) {
		push(@search, parseAddr($header{$_}) ) if /$headers/;
	}

	#
	# Do the search
	#
	my ($email, @add);
	foreach $email ( uniq(@search) ) {
		push( @add, $email ) if ! search( \@patterns, [$email] );
	}

	#
	# Append to greylist
	#
	select(STDERR);
	my $mail = $opt{mail};
	my $file = $opt{append};
	my $dest = $opt{dest};
	my $from = $opt{from};
	$dest = $file unless $dest;
	$from = $ENV{USER} unless $from;
	if( $file ) {
		open( LIST, ">>$file" ) || die "$file: $!\n";
		select( LIST );
	}

	if( @add ) {
		$_ = join("\n", @add )."\n";
		print;
		if ($mail) {
			sendEmail("To: $mail\n".
					  "From: Mail Filter <$from>\n".
					  "Subject: addresses added\n",
					  "The following addresses have been added to $dest:\n\n$_");
		}
	}

	close(LIST) if $file;

	return 0;
}


#
# Run ChkMail
#
sub chkmail {
	local(@ARGV) = @_;

	#
	# Parse options
	#
	my %opt;
	chkmailusage if !GetOptions(\%opt, "body", "header=s@", "verbose");
	chkmailusage if !@ARGV;
	$opt{"header"} = [ "From|Sender" ] if !$opt{"header"};

	#
	# Load pattern files
	#
	my @patterns = ();
	readPatternFiles( \@patterns, @ARGV );

	#
	# Read in email from STDIN
	#
	my (%header, $head, $body);
	parseEmail(\%header, \$head, \$body);

	#
	# Find relevant headers/body to search
	#
	my $headers = lc "^(Resent-)?(".join("|", @{$opt{"header"}}).")\$";
	my @search = ();
	push(@search, $body) if $opt{"body"};
	foreach (keys %header) {
		push(@search, $header{$_}) if /$headers/;
	}

	#
	# Do the search
	#
	@_ = search(\@patterns, \@search);		# Search for pattern
	if( @_ ) {
		print STDERR "Matched: @_\n" if $opt{"verbose"};
		return 0;
	} else {
		print STDERR "No matches.\n" if $opt{"verbose"};
		return 1;
	}
}


#
# Run Query
#
sub runquery {
	my($path) = @_;

	#
	# Re-open STDIN for my path
	#
	open(STDIN, "<&=$path") || die "Error: could not change STDIN -- $!\n";

	#
	# Parse options
	#
	my $line = <STDIN>;
	chomp($line);
	my @args = split(/ /,$line);
	my $cmd  = shift @args;
	$cmd =~ s|^.*/([^/]*)$|$1|;

#	print STDERR "cmd=$cmd, args=@args\n";
	my $retcode = 1;
	$retcode = chkmail(@args) if $cmd eq "chkmail";
	$retcode = addpat (@args) if $cmd eq "addpat";

	while (<STDIN>) {
		last if m/^From ===done===$/;
	}

	return $retcode;
}


usage() if (@ARGV != 1);


unlink($ARGV[0]);
umask(077);
$sock = IO::Socket::UNIX->new(Type	=> SOCK_STREAM,
							  Local	=> $ARGV[0],
							  Listen=> 10);

close(STDOUT);
close(STDIN);

for (;;) {
	$connection = $sock->accept();

	$result = 1;
	eval {
		local $SIG{ALRM} = sub { die "Warning: timeout running query\n" };
		local $SIG{PIPE} = sub { die "Warning: socket closed unexpectedly\n" };
		alarm(5);
		$result = runquery($connection->fileno());
	};
	alarm(0);

#	print STDERR $@ if $@;

	$connection->autoflush(1);
	$connection->printf("%d\n",$result);

	eval {
		local $SIG{PIPE} = sub {};
		close(STDIN);
	};

	$connection->close();
}

#print STDERR "$0 exited!\n";
