#! /usr/bin/perl -W
# based on sample from Postfix Page
use strict;
use Errno;
use IO::Select;
use IO::File;
my $fds;
my $flog;
my $conffile;
my %times = ();
my $maxcount = 750; # max mail per hour
sub init_sockets;
# initialize anything (database etc)
sub init() {
$fds = IO::Select->new() or die "unable to create IO::Select object\n";
init_sockets('inet:127.0.0.1:8895');
use IO::File;
$flog = IO::File->new("/tmp/smtpd-policy.log", 'a');
}
init();
sub request($;$) {
my ($attr,$sock) = @_;
my $act = 'DUNNO';
my $now = time;
open(FILE, "/tmp/postfix-counter");
while(<FILE>){
chomp($_);
my ($key, $val) = split(/:/, $_);
$times{$key} = $val;
}
close(FILE);
if ($times{'1htime'} + 3600 > $now){
if ($times{'1hcount'} < $maxcount){
my $tmp = $times{'1hcount'};
$tmp = $tmp + 1;
$times{'1hcount'} = $tmp;
$act = 'OK';
$times{'now'} = $now;
}else{
$act = 'DEFER to many mail';
$times{'now'} = $now;
}
}else{
$times{'1htime'} = $now;
$times{'1hcount'} = 1;
$act = 'OK';
$times{'now'} = $now;
}
open(FILE, ">/tmp/postfix-counter");
for my $key ( keys %times ) {
my $value = $times{$key};
print FILE "$key:$value\n";
}
close(FILE);
if (defined $flog) {
$flog->print("request:");
$flog->print(" $_=$attr->{$_}") foreach keys %$attr;
$flog->print(" action=$act\n");
$flog->flush;
}
$act;
}
sub request_cb($) {
my $s = shift;
my $r = ${*$s}{attrs} || ( ${*$s}{attrs} = {} );
for(;;) {
$_ = $s->getline;
unless (defined $_) {
$fds->remove($s) unless $!{EAGAIN};
return;
}
if (/^([a-zA-Z_]+)=([^\r\n]*)\r?\n$/) { $r->{$1} = $2; }
elsif (/^\r?\n$/) { last; }
else { $r->{error} = 1; }
}
${*$s}{attrs} = undef;
my $act;
if ($r->{error}) { $act = 'ERROR unknown request line'; }
elsif (!exists($r->{request}) ||
$r->{request} ne 'smtpd_access_policy') {
$act = 'ERROR required request attribute is not present';
}
else {
$act = request($r);
unless (defined $act) {
$fds->remove($s);
return;
}
}
$s->print("action=$act\n\n") or $fds->remove($s);
}
sub accept_cb($) {
my $ls = shift;
my $s = $ls->accept;
if ($s) {
$s->blocking(0);
${*$s}{cb} = \&request_cb;
$fds->add($s);
}
}
sub init_sockets {
foreach my $sock ( @_ ) {
my $s;
if ($sock =~ /^inet:([^:]+:.+)$/i) {
use IO::Socket::INET;
$s = IO::Socket::INET->new(
LocalAddr => $1,
Proto => 'tcp',
Type => SOCK_STREAM,
Listen => 5,
ReuseAddr => 1,
);
}
elsif ($sock =~ /^unix:(.+)$/) {
use IO::Socket::UNIX;
unlink $1;
$s = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Local => $1,
Listen => 5,
);
}
else {
die "invalid listening point specification: $sock\n";
}
die "unable to create listening socket for $sock: $!\n" unless $s;
$s->blocking(0);
${*$s}{cb} = \&accept_cb;
$fds->add($s);
}
}
for(;;) {
foreach my $s ( $fds->can_read() ) {
&{${*$s}{cb}}($s);
}
}
