1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#!/usr/bin/perl
use IO::Socket::INET;
use Sys::Syslog qw(:DEFAULT setlogsock);
# Modify these variables if needed to point to your BLD daemon
my $bld_host = "localhost";
my $bld_port = "2905";
#
# Usage: bld-postfix_policy.pl [-v]
#
# Demo delegated Postfix SMTPD policy server. This server implements
# interaction with BLD and is heavily based on example greylist.pl from
# Postfix 2.1. Logging is sent to syslogd.
#
# How it works: each time a Postfix SMTP server process is started
# it connects to the policy service socket, and Postfix runs one
# instance of this PERL script. By default, a Postfix SMTP server
# process terminates after 100 seconds of idle time, or after serving
# 100 clients. Thus, the cost of starting this PERL script is smoothed
# out over time.
#
# To run this from /etc/postfix/master.cf:
#
# bld-policy unix - n n - - spawn
# user=nobody argv=/usr/bin/perl /usr/libexec/postfix/bld-postfix_policy.pl
#
# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
#
# smtpd_recipient_restrictions =
# ...
# reject_unauth_destination
# check_policy_service unix:private/bld-policy
# ...
#
# NOTE: specify check_policy_service AFTER reject_unauth_destination
# or else your system can become an open relay.
#
# To test this script by hand, execute:
#
# % perl bld-postfix_policy.pl
#
# Each query is a bunch of attributes. Order does not matter, and
# the demo script uses only a few of all the attributes shown below:
#
# request=smtpd_access_policy
# protocol_state=RCPT
# protocol_name=SMTP
# helo_name=some.domain.tld
# queue_id=8045F2AB23
# sender=foo@bar.tld
# recipient=bar@foo.tld
# client_address=1.2.3.4
# client_name=another.domain.tld
# instance=123.456.7
# sasl_method=plain
# sasl_username=you
# sasl_sender=
# size=12345
# [empty line]
#
# The policy server script will answer in the same style, with an
# attribute list followed by a empty line:
#
# action=dunno
# [empty line]
#
#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
$syslog_socktype = 'unix'; # inet, unix, stream, console
$syslog_facility="mail";
$syslog_options="pid";
$syslog_priority="info";
#
# BLD query submission routine. Return the action to take for the given
# IP
#
sub bld_query($$$)
{
my ($host, $port, $ip) = @_;
my $sd = IO::Socket::INET->new(PeerHost => $host, PeerPort => $port)
|| return undef;
my $action = "dunno"; # Default action
my $buf;
return $action if (sysread($sd, $buf, 1024) <= 0);
syswrite($sd, "ip?=$ip\r\n");
return $action if (sysread($sd, $buf, 1024) <= 0);
close($sd);
return "defer_if_permit Too many Users unknown from this IP" if ($buf =~ /^421 /);
return $action;
}
#
# Log an error and abort.
#
sub fatal_exit {
my($first) = shift(@_);
syslog "err", "fatal: $first", @_;
exit 1;
}
#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $0, $syslog_options, $syslog_facility;
#
# We don't need getopt() for now.
#
while ($option = shift(@ARGV)) {
if ($option eq "-v") {
$verbose = 1;
} else {
syslog $syslog_priority, "Invalid option: %s. Usage: %s [-v]",
$option, $0;
exit 1;
}
}
#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);
#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
while (<STDIN>) {
if (/([^=]+)=(.*)\n/) {
$attr{substr($1, 0, 512)} = substr($2, 0, 512);
} elsif ($_ eq "\n") {
if ($verbose) {
for (keys %attr) {
syslog $syslog_priority, "Attribute: %s=%s", $_, $attr{$_};
}
}
fatal_exit "unrecognized request type: '%s'", $attr{request}
unless $attr{"request"} eq "smtpd_access_policy";
$action = bld_query($bld_host, $bld_port, $attr{client_address});
syslog $syslog_priority, "Action: %s", $action if $verbose;
print STDOUT "action=$action\n\n";
%attr = ();
} else {
chop;
syslog $syslog_priority, "warning: ignoring garbage: %.100s", $_;
}
}
|
