FreeBSDAdmin/Mail/FalsePositive.pl

#!/usr/bin/perl
# False Positive
#
# Douglas Thrift
#
# $Id$

use strict;
use warnings;

use Mail::Cclient;
use Mail::SpamAssassin;
use POSIX qw(:signal_h);

my $error;
my $debug = 0;
my @messages;
my $critical = 0;
my $set = POSIX::SigSet->new(&POSIX::SIGHUP, &POSIX::SIGINT);

for my $arg (@ARGV)
{
        if ($arg eq "-debug")
        {
                $debug = 1;
        }
        else
        {
                print "Usage: $0 [-debug]\n";

                exit 1;
        }
}

Mail::Cclient::set_callback(flags => \&mm_flags, status => \&mm_status, searched => \&mm_searched, exists => \&mm_exists, notify => \&mm_notify, log => \&mm_log, dlog => \&mm_dlog, critical => \&mm_critical, nocritical => \&mm_nocritical, diskerror => \&mm_diskerror, fatal => \&mm_fatal);

my $positive = Mail::Cclient->new('Spam/False Positive', $debug ? 'debug' : ()) or die "$0: $error\n";

$positive->search(SEARCH => 'UNFLAGGED');

my $assassin = Mail::SpamAssassin->new($debug ? {debug => 'all'} : {});

$positive->fetch_flags(join(',', @messages));

for my $message (@messages)
{
        my $message_ = $assassin->remove_spamassassin_markup($assassin->parse($positive->fetch_message($message)));

        # XXX: stupid SpamAssassin!
        if ($message_ =~ /^((?:[!-9;-~]+:[^\r\n]+\n(?:[ \t][^\r\n]+\n)*)+\n)(.*)$/s)
        {
                my ($header, $body) = ($1, $2);

                $header =~ s/\n/\r\n/gs;

                $message_ = $header . $body;
        }

        $positive->append('INBOX', $message_, $positive->elt($message)->imapdate);
        $positive->setflag($message, '\Flagged');
}

$positive->close();

sub mm_flags
{
        if ($debug)
        {
                print STDERR "flags: $_[1]\n";
        }
}

sub mm_status
{
        if ($debug)
        {
                print STDERR "status: $_[1]\n";

                for (my $index; $index != $#_; $index += 2)
                {
                        if ($_[$index] eq 'messages')
                        {
                                print STDERR "   messages: $_[$index + 1]\n";
                        }
                        elsif ($_[$index] eq 'recent')
                        {
                                print STDERR "   recent: $_[$index + 1]\n";
                        }
                        elsif ($_[$index] eq 'unseen')
                        {
                                print STDERR "   unseen: $_[$index + 1]\n";
                        }
                        elsif ($_[$index] eq 'uidnext')
                        {
                                print STDERR "   uid next: $_[$index + 1]\n";
                        }
                        elsif ($_[$index] eq 'uidvalidity')
                        {
                                print STDERR "   uid validity: $_[$index + 1]\n";
                        }
                }
        }
}

sub mm_searched
{
        $messages[$#messages + 1] = $_[1];
}

sub mm_exists
{
        if ($debug)
        {
                print STDERR "exists: $_[1]\n";
        }
}

sub mm_notify
{
        if ($debug)
        {
                print STDERR "$_[2]: $_[1]\n";
        }
}

sub mm_log
{
        if ($debug)
        {
                print STDERR "$_[1]: $_[0]\n";
        }

        if ($_[1] eq 'error')
        {
                $error = $_[0];
        }
}

sub mm_dlog
{
        print STDERR "$_[0]\n";
}

sub mm_critical
{
        if (!$critical++)
        {
                POSIX::sigprocmask(POSIX::SIG_BLOCK, $set) or die;
        }
}

sub mm_nocritical
{
        if (!--$critical)
        {
                POSIX::sigprocmask(POSIX::SIG_UNBLOCK, $set) or die;
        }
}

sub mm_diskerror
{
        print STDERR "diskerror: $_[1]" . $_[2] ? " serious\n" : "\n";

        return 1;
}

sub mm_fatal
{
        print STDERR "fatal: $_[0]\n";
}
Revision:	833
Committed:	2006-07-07T07:27:48-07:00 (18 years, 11 months ago) by douglas
Content type:	text/x-perl
File size:	2830 byte(s)
Log Message:	...
#	User	Rev	Content
1	douglas	811	#!/usr/bin/perl
2			# False Positive
3			#
4			# Douglas Thrift
5			#
6			# $Id$
7
8			use strict;
9			use warnings;
10
11	douglas	829	use Mail::Cclient;
12	douglas	811	use Mail::SpamAssassin;
13	douglas	829	use POSIX qw(:signal_h);
14	douglas	811
15	douglas	829	my $error;
16			my $debug = 0;
17			my @messages;
18			my $critical = 0;
19			my $set = POSIX::SigSet->new(&POSIX::SIGHUP, &POSIX::SIGINT);
20	douglas	811
21	douglas	829	for my $arg (@ARGV)
22	douglas	811	{
23	douglas	829	if ($arg eq "-debug")
24			{
25			$debug = 1;
26			}
27			else
28			{
29			print "Usage: $0 [-debug]\n";
30
31			exit 1;
32			}
33	douglas	811	}
34
35	douglas	833	Mail::Cclient::set_callback(flags => \&mm_flags, status => \&mm_status, searched => \&mm_searched, exists => \&mm_exists, notify => \&mm_notify, log => \&mm_log, dlog => \&mm_dlog, critical => \&mm_critical, nocritical => \&mm_nocritical, diskerror => \&mm_diskerror, fatal => \&mm_fatal);
36	douglas	811
37	douglas	829	my $positive = Mail::Cclient->new('Spam/False Positive', $debug ? 'debug' : ()) or die "$0: $error\n";
38
39			$positive->search(SEARCH => 'UNFLAGGED');
40
41			my $assassin = Mail::SpamAssassin->new($debug ? {debug => 'all'} : {});
42
43			$positive->fetch_flags(join(',', @messages));
44
45			for my $message (@messages)
46			{
47			my $message_ = $assassin->remove_spamassassin_markup($assassin->parse($positive->fetch_message($message)));
48
49			# XXX: stupid SpamAssassin!
50			if ($message_ =~ /^((?:[!-9;-~]+:[^\r\n]+\n(?:[ \t][^\r\n]+\n))+\n)(.)$/s)
51			{
52			my ($header, $body) = ($1, $2);
53
54			$header =~ s/\n/\r\n/gs;
55
56			$message_ = $header . $body;
57			}
58
59			$positive->append('INBOX', $message_, $positive->elt($message)->imapdate);
60			$positive->setflag($message, '\Flagged');
61			}
62
63			$positive->close();
64
65	douglas	833	sub mm_flags
66			{
67			if ($debug)
68			{
69			print STDERR "flags: $_[1]\n";
70			}
71			}
72
73			sub mm_status
74			{
75			if ($debug)
76			{
77			print STDERR "status: $_[1]\n";
78
79			for (my $index; $index != $#_; $index += 2)
80			{
81			if ($_[$index] eq 'messages')
82			{
83			print STDERR " messages: $_[$index + 1]\n";
84			}
85			elsif ($_[$index] eq 'recent')
86			{
87			print STDERR " recent: $_[$index + 1]\n";
88			}
89			elsif ($_[$index] eq 'unseen')
90			{
91			print STDERR " unseen: $_[$index + 1]\n";
92			}
93			elsif ($_[$index] eq 'uidnext')
94			{
95			print STDERR " uid next: $_[$index + 1]\n";
96			}
97			elsif ($_[$index] eq 'uidvalidity')
98			{
99			print STDERR " uid validity: $_[$index + 1]\n";
100			}
101			}
102			}
103			}
104
105	douglas	829	sub mm_searched
106			{
107			$messages[$#messages + 1] = $_[1];
108			}
109
110	douglas	833	sub mm_exists
111			{
112			if ($debug)
113			{
114			print STDERR "exists: $_[1]\n";
115			}
116			}
117
118			sub mm_notify
119			{
120			if ($debug)
121			{
122			print STDERR "$_[2]: $_[1]\n";
123			}
124			}
125
126	douglas	829	sub mm_log
127			{
128			if ($debug)
129			{
130	douglas	833	print STDERR "$_[1]: $_[0]\n";
131	douglas	829	}
132
133			if ($_[1] eq 'error')
134			{
135			$error = $_[0];
136			}
137			}
138
139			sub mm_dlog
140			{
141			print STDERR "$_[0]\n";
142			}
143
144			sub mm_critical
145			{
146			if (!$critical++)
147			{
148			POSIX::sigprocmask(POSIX::SIG_BLOCK, $set) or die;
149			}
150			}
151
152			sub mm_nocritical
153			{
154			if (!--$critical)
155			{
156			POSIX::sigprocmask(POSIX::SIG_UNBLOCK, $set) or die;
157			}
158			}
159
160			sub mm_diskerror
161			{
162	douglas	833	print STDERR "diskerror: $_[1]" . $_[2] ? " serious\n" : "\n";
163	douglas	829
164			return 1;
165			}
166	douglas	831
167			sub mm_fatal
168			{
169	douglas	833	print STDERR "fatal: $_[0]\n";
170	douglas	831	}