#!/usr/local/bin/perl5.6.1t

# $Id: snoop.milter.pl,v 1.7 2002/08/21 04:56:03 dredd Exp $

use Sendmail::Milter;

$0 = 'Sendmail Milter - Snoop';


my %snoop_on = ( '\@megacity\.org\.uk' => '<somesnoop@megacity.org>' );

my $DEBUG = 1;

sub connect_callback : locked
{
    my $ctx = shift;
    my $hostname = shift;
    my $sockaddr_in = shift;
    my ($port, $iaddr);
    
    my %hash = ();
    $ctx->setpriv(\%hash);
    print "returning from connect callback\n" if $DEBUG;
    return SMFIS_CONTINUE;
}

sub envfrom_callback : locked
{
    my $ctx = shift;
    my @args = @_;
    print "entering from callback\n" if $DEBUG;
    my $sender = $args[0];
    $sender =~ s/^\<//; $sender =~ s/\>$//;
    foreach my $regex (keys %snoop_on)
    {
	if ($sender =~ /$regex/)
	{
	    print "$sender is someone we're snoopig on.\n" if $DEBUG;
	    my $watcher = $snoop_on{$regex};
	    my $href = $ctx->getpriv();
	    my @rcpts = ();
	    if (defined $$href{'watchers'})
	    {
		@rcpts = @{$$href{'watchers'}};
	    }
	    push @rcpts, ($watcher);
	    $$href{'watchers'} = \@rcpts;
	    $ctx->setpriv($href);
	}
    }
    return SMFIS_CONTINUE;
}

sub envrcpt_callback : locked
{
    my $ctx = shift;
    my @args = @_;
    
    my $recip = $args[0];
    $recip =~ s/^\<//; $recip =~ s/\>$//;

    foreach my $regex (keys %snoop_on)
    {
	if ($recip =~ /$regex/)
	{
	    print "$recip is someone we're snoopig on.\n" if $DEBUG;
	    my $watcher = $snoop_on{$regex};
	    my $href = $ctx->getpriv();
	    my @rcpts = ();
	    if (defined $$href{'watchers'})
	    {
		@rcpts = @{$$href{'watchers'}};
	    }
	    push @rcpts, ($watcher);
	    $$href{'watchers'} = \@rcpts;
	    $ctx->setpriv($href);
	}
    }
    return SMFIS_CONTINUE;
}

sub eom_callback : locked
{
    my $ctx = shift;
    my $href = $ctx->getpriv();
    $ctx->setpriv($href);
    if (defined $$href{'watchers'})
    {
	my @watchers = @{$$href{'watchers'}};
	foreach my $watcher (@watchers)
	{
	    $ctx->addrcpt($watcher);
	}
    }
    return SMFIS_CONTINUE;
}

sub abort_callback
{
    my $ctx = shift;
    
    print "my_abort:\n" if $DEBUG;
    
    $ctx->setpriv(undef);
    print "   + private data cleared.\n" if $DEBUG;
    
    print "   + callback completed.\n" if $DEBUG;
    
    return SMFIS_CONTINUE;
}

sub close_callback
{
    my $ctx = shift;
    print "my_close:\n" if $DEBUG;
    
    $ctx->setpriv(undef);
    print "   + private data cleared.\n" if $DEBUG;
    
    print "   + callback completed.\n" if $DEBUG;
    
    return SMFIS_CONTINUE;
}

my %my_callbacks =
(
	'connect' =>	\&connect_callback,
	'envfrom' =>	\&envfrom_callback,
	'envrcpt' =>	\&envrcpt_callback,
	'eom' =>	\&eom_callback,
	'abort' =>	\&abort_callback,
	'close' =>	\&close_callback,
);

BEGIN:
{
    if (scalar(@ARGV) < 2)
    {
	print "Usage: perl $0 <name_of_filter> <path_to_sendmail.cf>\n";
	exit;
    }
    
    my $conn = Sendmail::Milter::auto_getconn($ARGV[0], $ARGV[1]);
    
    my $DEBUG = 0;
    
    print "Found connection info for '$ARGV[0]': $conn\n" if $DEBUG;
    
    if ($conn =~ /^local:(.+)$/)
    {
	my $unix_socket = $1;
	
	if (-e $unix_socket)
	{
	    print "Attempting to unlink UNIX socket '$conn' ... " if $DEBUG;
	    
	    if (unlink($unix_socket) == 0)
	    {
		print "failed.\n" if $DEBUG;
		exit;
	    }
	    print "successful.\n" if $DEBUG;
	}
    }
    
    if (not Sendmail::Milter::auto_setconn($ARGV[0], $ARGV[1]))
    {
	print "Failed to detect connection information.\n";
	exit;
    }
    
    #
    #  The flags parameter is optional. SMFI_CURR_ACTS sets all of the
    #  current version's filtering capabilities.
    #
    #  %Sendmail::Milter::DEFAULT_CALLBACKS is provided for you in getting
    #  up to speed quickly. I highly recommend creating a callback table
    #  of your own with only the callbacks that you need.
    #
    
    if (not Sendmail::Milter::register($ARGV[0], \%my_callbacks,
				       SMFI_CURR_ACTS))
    {
	print "Failed to register callbacks for $ARGV[0].\n";
	exit;
	}
    
    print "Starting Sendmail::Milter $Sendmail::Milter::VERSION engine.\n" if $DEBUG;
    
    if (Sendmail::Milter::main())
    {
	print "Successful exit from the Sendmail::Milter engine.\n";
    }
    else
    {
	print "Unsuccessful exit from the Sendmail::Milter engine.\n";
    }
}